From 459a74455ca4bce758ddd3b82181dc503cf5b19c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 9 Apr 2017 07:48:01 -0600 Subject: [PATCH] avoid platform-specific path conventions in "info-cache.rktd" Store relative paths in "info-cache.rktd" (which corresponds, roughly, to packages) in a platform-independent form, instead of using the current platform's convention. Using the current platform's covention works badly when cross-compiling for Windows on Unix, since relative paths are used as keys in the "info-cache.rktd" table. For example, updating a pre-installed package on Windows mangles the mapping if the installer is created from a cross-compiled installation. --- racket/collects/setup/getinfo.rkt | 14 ++++++---- .../setup/private/encode-relative.rkt | 21 ++++++++++++++ racket/collects/setup/setup-core.rkt | 28 +++++++++++++++---- 3 files changed, 52 insertions(+), 11 deletions(-) create mode 100644 racket/collects/setup/private/encode-relative.rkt diff --git a/racket/collects/setup/getinfo.rkt b/racket/collects/setup/getinfo.rkt index fe802c5430..b860590d3c 100644 --- a/racket/collects/setup/getinfo.rkt +++ b/racket/collects/setup/getinfo.rkt @@ -5,7 +5,8 @@ planet/cachepath syntax/modread "dirs.rkt" - "path-relativize.rkt") + "path-relativize.rkt" + "private/encode-relative.rkt") ;; in addition to infodomain/compiled/cache.rktd, getinfo will look in this ;; file to find mappings. PLaneT uses this to put info about installed @@ -243,7 +244,9 @@ [else (error 'find-relevant-directories "bad info-domain cache file: ~a" f)]))]) (match i - [(list (and pathbytes (or (? bytes?) (list (or 'info 'share) (? bytes?) ...))) + [(list (and pathbytes (or (? bytes?) + (list (or 'info 'share) (? bytes?) ...) + (list 'rel (or 'up (? bytes?)) ...))) (list (? symbol? fields) ...) key ;; anything is okay here (? integer? maj) @@ -259,9 +262,10 @@ ;; but it's ok to support them: (simplify-path (build-path root-dir p)) p)) - (if (eq? (car pathbytes) 'info) - (info-relative->path pathbytes) - (main-share-relative->path pathbytes))) + (case (car pathbytes) + [(rel) (simplify-path (build-path root-dir (decode-relative-path pathbytes)))] + [(info) (info-relative->path pathbytes)] + [(lib) (main-share-relative->path pathbytes)])) fields)]) (hash-set! colls key ((table-insert t) root-dir new-item old-items)))] diff --git a/racket/collects/setup/private/encode-relative.rkt b/racket/collects/setup/private/encode-relative.rkt new file mode 100644 index 0000000000..bc9039eb55 --- /dev/null +++ b/racket/collects/setup/private/encode-relative.rkt @@ -0,0 +1,21 @@ +#lang racket/base + +;; Similar to "../path-relativize.rkt", but works on already-releative +;; paths and allows ".." in the path. + +(provide encode-relative-path + decode-relative-path) + +(define (encode-relative-path p) + (cons 'rel + (for/list ([e (in-list (explode-path p))]) + (if (path? e) + (path-element->bytes e) + e)))) + +(define (decode-relative-path l) + (apply build-path + (for/list ([e (in-list (cdr l))]) + (if (bytes? e) + (bytes->path-element e) + e)))) diff --git a/racket/collects/setup/setup-core.rkt b/racket/collects/setup/setup-core.rkt index c04a687c8d..d169015920 100644 --- a/racket/collects/setup/setup-core.rkt +++ b/racket/collects/setup/setup-core.rkt @@ -39,6 +39,7 @@ "private/pkg-deps.rkt" "collection-name.rkt" "private/format-error.rkt" + "private/encode-relative.rkt" compiler/private/dep (only-in pkg/lib pkg-directory pkg-single-collection)) @@ -1160,9 +1161,23 @@ (set! all-ok? #t) (for ([i l]) (match i - [(list (and a (or (? bytes?) (list (or 'info 'lib) (? bytes?) ...))) + [(list (and a (or (? bytes?) + (list (or 'info 'lib) (? bytes?) ...) + (list 'rel (or 'up (? bytes?)) ...))) (list (? symbol? b) ...) c (? integer? d) (? integer? e)) - (define p (if (bytes? a) (bytes->path a) a)) + (define p + (cond + [(bytes? a) (bytes->path a)] + [(and (pair? a) (eq? 'rel (car a))) + (decode-relative-path a)] + [else a])) + (define (normalize-relative-encoding a p) + (if (and (bytes? a) (relative-path? p)) + ;; Convert to encoded form, since new entries will + ;; use encoding to avoid path-convention problems + ;; with cross-compilation: + (encode-relative-path p) + a)) ;; Check that the path is suitably absolute or relative: (define dir (case info-path-mode @@ -1219,7 +1234,7 @@ (not (eq? 'all (omitted-paths dir getinfo/log-failure omit-root))))) (or (file-exists? (build-path dir "info.rkt")) (file-exists? (build-path dir "info.ss")))) - (hash-set! t a (list b c d e)) + (hash-set! t (normalize-relative-encoding a p) (list b c d e)) (begin (when (verbose) (printf " drop entry: ~s\n" i)) (set! all-ok? #f)))] [_ (when (verbose) (printf " bad entry: ~s\n" i)) @@ -1263,9 +1278,10 @@ (let ([p (path->main-lib-relative (cc-path cc))]) (if (path? p) ;; Fall back to relative (with ".."s) to info root: - (path->bytes (find-relative-path (cc-info-root cc) - p - #:more-than-root? #t)) + (encode-relative-path + (find-relative-path (cc-info-root cc) + p + #:more-than-root? #t)) p))] [else (path->bytes (cc-path cc))]) (cons (domain) (cc-shadowing-policy cc)))))