Windows: fix handling of junctions as links

On Windows, a "soft link" or "junction" is different from a
"symbolic link". The current Windows documentation is
incomplete in that it describes the behavior of GetFileAttributesEx
for a symbolic link, but not for a junction, and I guessed wrong.
For consistency, junctions need to be treated like symbolic links.

pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl

@@ -243,6 +243,7 @@ On Windows, @racket[file-exists?]  reports @racket[#t] for all
 variations of the special filenames (e.g., @racket["LPT1"],
 @racket["x:/baddir/LPT1"]).}
 
+
 @defproc[(link-exists? [path path-string?]) boolean?]{
 
 Returns @racket[#t] if a link @racket[path] exists,
@@ -257,6 +258,9 @@ path).
 This procedure never raises the @racket[exn:fail:filesystem]
 exception.
 
+On Windows, @racket[link-exists?] reports @racket[#t] for both
+symbolic links and junctions.
+
 @history[#:changed "6.0.1.12" @elem{Added support for links on Windows.}]}
 
 
@@ -264,7 +268,11 @@ exception.
 
 Deletes the file with path @racket[path] if it exists, otherwise the
 @exnraise[exn:fail:filesystem]. If @racket[path] is a link, the link
-is deleted rather than the destination of the link.}
+is deleted rather than the destination of the link.
+
+On Windows, @racket[delete-file] can delete a symbolic link, but not
+a junction. Use @racket[delete-directory] to delete a junction.}
+
 
 @defproc[(rename-file-or-directory [old path-string?]
                                    [new path-string?]
@@ -406,6 +414,8 @@ On Windows XP and earlier, the @exnraise[exn:fail:unsupported]. On
 later versions of Windows, the creation of links tends to be
 disallowed by security policies. Furthermore, a relative-path link is
 parsed specially; see @secref["windowspaths"] for more information.
+When @racket[make-file-or-directory-link] succeeds, it creates a symbolic
+link as opposed to a junction.
 
 @history[#:changed "6.0.1.12" @elem{Added support for links on Windows.}]}
 

pkgs/racket-pkgs/racket-test/tests/racket/win-link.rkt

@@ -1,5 +1,7 @@
 #lang racket/base
-(require racket/file)
+(require racket/file
+	 racket/system
+	 racket/format)
 
 ;; Run this test on a Windows machine with a user that is allowed
 ;; to create symbolic links. Since that's not usually the case,
@@ -28,8 +30,9 @@
 (define sub (build-path temp-dir sub-name))
 (delete-directory/files sub #:must-exist? #f)
 (make-directory* sub)
-
-(define (go build tbuild rbuild)
+(define (go build tbuild rbuild
+	    #:mklink [make-____-__-directory-link make-file-or-directory-link]
+	    #:rmlink [delete-____ delete-file])
   (test #f (link-exists? (build "l1")))
 
   ;; t1 -> l1
@@ -73,7 +76,7 @@
   (delete-file (build "l2"))
 
   ;; Link to dir in dir with "." path elements
-  (make-file-or-directory-link (let ([p (rbuild "t1")])
+  (make-____-__-directory-link (let ([p (rbuild "t1")])
 				 (if (path? p)
 				     (build-path p 'same 'same "f2" 'same)
 				     (string-append p "\\.\\.\\f2\\.")))
@@ -81,7 +84,7 @@
   (test #t (directory-exists? (build "l2")))
   (test "t1-f2-f3" (file->string (build-path (build "l2") "f3")))
   (test (list (string->path "f3")) (directory-list (build "l2")))
-  (delete-file (build "l2"))
+  (delete-____ (build "l2"))
 
   ;; Link with ".." to cancel first link element
   (make-file-or-directory-link (let ([p (rbuild "t1")])
@@ -108,7 +111,7 @@
   (delete-file (build "l3"))
 
   ;; Trailing ".."
-  (make-file-or-directory-link (let ([p (rbuild "t1")])
+  (make-____-__-directory-link (let ([p (rbuild "t1")])
 				 (if (path? p)
 				     (build-path p 'up)
 				     (string-append p "\\..")))
@@ -118,7 +121,7 @@
   (test #t (directory-exists? (build "l3")))
   (test "(f4)" (file->string (build-path (build "l3") "f4")))
   (delete-file (build-path sub "f4"))
-  (delete-file (build "l3"))
+  (delete-____ (build "l3"))
 
   ;; Forward slashes (ok for absolute, not ok for relative)
   (define abs? (absolute-path? (rbuild "t1")))
@@ -174,8 +177,13 @@
   (define-values (base name dir) (split-path (in-sub/unc s)))
   (build-path base (trailing-space s)))
 
+(define (make-junction dest src)
+  (unless (system (~a "mklink /j " src " " dest))
+    (error)))
+
 (go in-sub in-sub values)
 (go in-sub in-sub in-sub)
+(go in-sub in-sub in-sub #:mklink make-junction #:rmlink delete-directory)
 (parameterize ([current-directory sub])
   (go values values values)
   (go values in-sub in-sub))

racket/src/racket/src/file.c

@@ -2228,7 +2228,8 @@ static char *UNC_readlink(const char *fn)
 
   h = CreateFileW(WIDE_PATH(fn), GENERIC_READ,
 		  FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL,
-		  OPEN_EXISTING, mzFILE_FLAG_OPEN_REPARSE_POINT,
+		  OPEN_EXISTING,
+		  FILE_FLAG_BACKUP_SEMANTICS | mzFILE_FLAG_OPEN_REPARSE_POINT,
 		  NULL);
 
   if (h == INVALID_HANDLE_VALUE) {
@@ -2254,7 +2255,8 @@ static char *UNC_readlink(const char *fn)
   CloseHandle(h);
 
   rp = (mz_REPARSE_DATA_BUFFER *)buffer;
-  if (rp->ReparseTag != IO_REPARSE_TAG_SYMLINK) {
+  if ((rp->ReparseTag != IO_REPARSE_TAG_SYMLINK)
+      && (rp->ReparseTag != IO_REPARSE_TAG_MOUNT_POINT)) {
     errno = -1;
     return NULL;
   }