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

repairs for build-path on \\?\RED\ paths

Browse Source 
A `\\?\RED\` path is Racket- and Windows-specific, and it's an extreme
corner case: a drive-relative absolute path that include elements that
must eb specially esacped. BC's `build-path` incorrectly allowed
`\\?\RED\` to extend an absolute path. CS's `build-path` incorrctly
allowed various absolute-path extensions, including `\\?\RED\` paths.
The documentation was slightly off.
This commit is contained in:
Matthew Flatt 2020-07-16 11:26:49 -06:00
parent 7709287e03
commit 6e3c111728
4 changed files with 22 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/racket-doc/scribblings/reference/windows-paths.scrbl
View File

@ -3,6 +3,8 @@
@(define MzAdd (italic "Racket-specific:"))
@(define (litchar~ s) (litchar (regexp-replace* "~" s " ")))
@title[#:tag "windowspaths"]{Windows Paths}
In general, a Windows pathname consists of an optional drive specifier
@ -249,8 +251,8 @@ Windows paths are @techlink{cleanse}d as follows: In paths that start
@litchar{\\?\}, redundant @litchar{\}s are removed, an extra
@litchar{\} is added in a @litchar{\\?\REL} if an extra one is
not already present to separate up-directory indicators from literal
path elements, and an extra @litchar{\} is similarly added after
@litchar{\\?\RED} if an extra one is not already present.
path elements, and an extra @litchar{\} is removed after
@litchar{\\?\RED} if an extra one is present.
@;{>> I don't know what was meant to go in place of "???", and I can't
figure out an example that could trigger this case: <<
When @litchar{\\?\} acts as the drive and the path contains ???, two
@ -310,8 +312,8 @@ already. Otherwise, if no indicators or redundant separators are in
For @racket[(split-path _path)] producing @racket[_base],
@racket[_name], and @racket[_must-be-dir?], splitting a path that does
not start with @litchar{\\?\} can produce parts that start with
@litchar{\\?\}. For example, splitting @litchar{C:/x~/aux/}
produces @litchar{\\?\C:\x~\} and @litchar{\\?\REL\\aux};
@litchar{\\?\}. For example, splitting @litchar~{C:/x~/aux/} twice
produces @litchar~{\\?\REL\\x~} and @litchar{\\?\REL\\aux};
the @litchar{\\?\} is needed in these cases to preserve a
trailing space after @litchar{x} and to avoid referring to the AUX
device instead of an @filepath{aux} file.

15
pkgs/racket-test-core/tests/racket/path.rktl
View File

@ -638,9 +638,12 @@
(test (string->path "\\") build-path (coerce "\\\\?\\RED\\a") 'up 'same)
(test (string->path "\\") build-path (coerce "\\\\?\\RED\\..") 'up)
(test (string->path "\\\\?\\RED\\\\..\\") build-path (coerce "\\\\?\\RED\\\\..") (coerce "\\\\?\\RED\\\\..") 'up)
(test (string->path "\\\\?\\RED\\\\x\\y\\..") build-path (coerce "/x/y") (coerce "\\\\?\\RED\\.."))
(test (string->path "\\\\?\\c:\\x\\y\\..") build-path (coerce "c:x/y") (coerce "\\\\?\\RED\\.."))
(test (string->path "\\\\?\\RED\\\\..\\") build-path (coerce "\\\\?\\RED\\\\..") (coerce "\\\\?\\REL\\\\..") 'up)
(test (string->path "\\\\?\\RED\\\\x\\y\\..") build-path (coerce "/x/y") (coerce "\\\\?\\REL\\\\.."))
(test (string->path "\\\\?\\c:\\x\\y\\..") build-path (coerce "c:x/y") (coerce "\\\\?\\REL\\\\.."))
(err/rt-test (build-path (coerce "\\\\?\\RED\\\\..") (coerce "\\\\?\\RED\\\\..") 'up))
(err/rt-test (build-path (coerce "/x/y") (coerce "\\\\?\\RED\\..")))
(test-values (list (string->path "\\\\?\\RED\\..\\")
(string->path "\\\\?\\REL\\\\a")
@ -693,8 +696,10 @@
(test (string->path "\\\\?\\UNC\\goo\\bar\\b") build-path (coerce "\\\\?\\UNC\\goo\\bar") (coerce "\\b"))
(test (string->path "\\\\?\\\\\\b") build-path (coerce "\\\\?\\") (coerce "\\b"))
(test (string->path "\\\\?\\\\\\b\\") build-path (coerce "\\\\?\\") (coerce "\\b\\"))
(err/rt-test (build-path "\\\\?\\c:" (coerce "\\b")) exn:fail:contract?)
(err/rt-test (build-path (coerce "\\\\?\\c:") (coerce "\\b")) exn:fail:contract?)
(err/rt-test (build-path (coerce "a") (coerce "\\b")) exn:fail:contract?)
;; Don't allow path addition on bad \\?\ to change the root:
(test (string->path "\\\\?\\\\\\c") build-path (coerce "\\\\?\\") (coerce "c"))
(test (string->path "\\\\?\\\\\\c:") build-path (coerce "\\\\?\\") (coerce "\\\\?\\REL\\c:"))

9
racket/src/io/path/build.rkt
View File

@ -115,9 +115,9 @@
(define (combine is-rel? is-complete? is-drive?)
(when (or is-complete?
(and (not is-rel?)
(not first?)
(not (and (null? (cdr accum))
(drive? (car accum))))))
(or (not first?)
(not (and (null? (cdr accum))
(drive? (car accum)))))))
(define what (if is-drive? "drive" "absolute path"))
(raise-arguments-error who
(string-append what " cannot be added to a base path")
@ -239,7 +239,8 @@
[(parse-unc s 0)
=> (lambda (drive-len) (just-separators-after? s drive-len))]
[(letter-drive-start? s (bytes-length s))
(just-separators-after? s 2)]))
(just-separators-after? s 2)]
[else #f]))
(struct starting-point (kind ; 'rel, 'red, 'unc, or 'abs
bstr ; byte string that contains the starting path

2
racket/src/racket/src/file.c
View File

@ -2228,7 +2228,7 @@ static Scheme_Object *do_build_path(int argc, Scheme_Object **argv, int idelta,
if (check_dos_slashslash_qm(next, len, &drive_end, NULL, &plus_sep)) {
if (drive_end < 0) {
/* \\?\REL\ or \\?\RED\ path */
rel = 1;
rel = (next[6] == 'L');
is_drive = 0;
if (i) {
int dots_end, lit_start;