setup/dirs: fix cases where paths are unavailable

When an executable distibution is created, some path become
unavailable at run time, such as the result of `find-links-file`.

Change the contract on those functions and adjust the implementation
to return `#f` in those cases. This is a backward-compatible change in
the sense that uses that now return `#f` would have crashed before
(although it does shift the blame in that case).

Based on an initial patch by Shu-Hung.

Closes #2352

pkgs/compiler-test/tests/compiler/embed/embed-me35.rkt

@@ -0,0 +1,19 @@
+#lang racket/base
+(require setup/dirs)
+
+(define (check-path-or-false p)
+  (unless (or (not p) (path? p))
+    (error 'embed-me35 "no good: ~s" p)))
+
+(define (check-list-of-paths ps)
+  (unless (and (list? ps) (andmap path? ps))
+    (error 'embed-me35 "no good: ~s" ps)))
+
+;; These directories are not available in a created distibution, but
+;; they shouldn't crash:
+(check-path-or-false (find-apps-dir))
+(check-path-or-false (find-pkgs-dir))
+(check-list-of-paths (get-pkgs-search-dirs))
+(check-path-or-false (find-links-file))
+
+'ok-35

pkgs/compiler-test/tests/compiler/embed/test.rkt

@@ -267,7 +267,8 @@
     (one-mz-test "embed-me19.rkt" "This is 19.\n" #f)
     (one-mz-test "embed-me21.rkt" "This is 21.\n" #f)
     (one-mz-test "embed-me31.rkt" "This is 31.\n" #f)
-    (one-mz-test "embed-me34.rkt" "This is 34 in a second place.\n" #f))
+    (one-mz-test "embed-me34.rkt" "This is 34 in a second place.\n" #f)
+    (one-mz-test "embed-me35.rkt" "'ok-35\n" #f))
 
   ;; Try unicode expr and cmdline:
   (prepare dest "unicode")

pkgs/racket-doc/scribblings/raco/setup.scrbl

@@ -1333,10 +1333,11 @@ current-system paths while @racket[get-cross-lib-search-dirs] and
   A @racket[#f] result indicates that no configuration directory
   is available.}
 
-@defproc[(find-links-file) path?]{
+@defproc[(find-links-file) (or/c path? #f)]{
   Returns a path to the installation's @tech[#:doc
   reference-doc]{collection links file}.  The file indicated by the
-  returned path may or may not exist.
+  returned path may or may not exist. A @racket[#f] result indicates
+  that no links file is available.
 
   @see-config[links-file]}
 
@@ -1345,7 +1346,7 @@ current-system paths while @racket[get-cross-lib-search-dirs] and
   links file}.  The file indicated by the returned path may or may not
   exist.}
 
-@defproc[(get-links-search-files) path?]{
+@defproc[(get-links-search-files) (listof path?)]{
   Returns a list of paths to installation @tech[#:doc
   reference-doc]{collection links files} to search in
   order. (Normally, the result includes the result of
@@ -1355,10 +1356,11 @@ current-system paths while @racket[get-cross-lib-search-dirs] and
 
   @see-config[links-search-files]}
 
-@defproc[(find-pkgs-dir) path?]{
+@defproc[(find-pkgs-dir) (or/c path? #f)]{
   Returns a path to the directory containing packages with
   installation scope; the directory indicated by the returned path may
-  or may not exist.
+  or may not exist. A @racket[#f] result indicates that no package-installation
+  directory is available.
 
   @see-config[pkgs-dir]}
 

racket/collects/launcher/launcher.rkt

@@ -534,7 +534,9 @@
                           dest))
   (define dir (if user?
                   (find-user-apps-dir)
-                  (find-apps-dir)))
+                  (or (find-apps-dir)
+                      (error 'installed-executable-path->desktop-path
+                             "no installation directory is available"))))
   (path-replace-extension (build-path dir (file-name-from-path dest))
                           #".desktop"))
 

racket/collects/pkg/path.rkt

@@ -36,7 +36,8 @@
   (if (path? scope)
       scope
       (case scope
-        [(installation) (find-pkgs-dir)]
+        [(installation) (or (find-pkgs-dir)
+                            (error 'get-pkgs-dir "no installation-scope packages directory is available"))]
         [(user) (find-user-pkgs-dir user-version)]
         [else (error "unknown package scope")])))
 

racket/collects/setup/link.rkt

@@ -31,7 +31,8 @@
   (define file (or in-file
                    (if user?
                        (build-path (find-system-path 'addon-dir) user-version "links.rktd")
-                       (find-links-file))))
+                       (or (find-links-file)
+                           (error 'links "no installation links file is available")))))
 
   (define need-repair? #f)
 

racket/collects/setup/private/dirs.rkt

@@ -265,7 +265,8 @@
   config:apps-dir
   find-apps-dir
   find-user-apps-dir #:default (build-path "share" "applications")
-  (chain-to (lambda () (build-path (find-share-dir) "applications"))))
+  (chain-to (lambda () (let ([p (find-share-dir)])
+                         (and p (build-path p "applications"))))))
 
 ;; ----------------------------------------
 ;; "man"
@@ -302,10 +303,14 @@
 
 (define (find-links-file)
   (or (force config:links-file)
-      (build-path (find-share-dir) "links.rktd")))
+      (let ([p (find-share-dir)])
+        (and p (build-path p "links.rktd")))))
 (define (get-links-search-files)
   (combine-search (force config:links-search-files)
-                  (list (find-links-file))))
+                  (let ([p (find-links-file)])
+                    (if p
+                        (list p)
+                        null))))
 
 (define (find-user-links-file [vers (get-installation-name)])
   (build-path (find-system-path 'addon-dir)
@@ -321,7 +326,8 @@
   get-false
   config:pkgs-search-dirs
   get-pkgs-search-dirs
-  (chain-to (lambda () (build-path (find-share-dir) "pkgs"))))
+  (chain-to (lambda () (let ([p (find-share-dir)])
+                         (and p (build-path p "pkgs"))))))
 
 (provide find-user-pkgs-dir)
 (define (find-user-pkgs-dir [vers (get-installation-name)])