This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pre-vista support for win32_symlink
authorTony Cook <tony@develop-help.com>
Mon, 9 Nov 2020 02:52:09 +0000 (13:52 +1100)
committerTony Cook <tony@develop-help.com>
Tue, 1 Dec 2020 04:29:33 +0000 (15:29 +1100)
win32/win32.c

index 65d154d..f18223d 100644 (file)
@@ -3448,6 +3448,12 @@ win32_link(const char *oldname, const char *newname)
     return -1;
 }
 
+typedef BOOLEAN (__stdcall *pCreateSymbolicLinkA_t)(LPCSTR, LPCSTR, DWORD);
+
+#ifndef SYMBOLIC_LINK_FLAG_DIRECTORY
+#  define SYMBOLIC_LINK_FLAG_DIRECTORY 0x1
+#endif
+
 #ifndef SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE
 #  define SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE 0x2
 #endif
@@ -3459,6 +3465,8 @@ win32_symlink(const char *oldfile, const char *newfile)
     const char *dest_path = oldfile;
     char szTargetName[MAX_PATH+1];
     size_t oldfile_len = strlen(oldfile);
+    pCreateSymbolicLinkA_t pCreateSymbolicLinkA =
+        (pCreateSymbolicLinkA_t)GetProcAddress(GetModuleHandle("kernel32.dll"), "CreateSymbolicLinkA");
     DWORD dest_attr;
     DWORD create_flags = 0;
 
@@ -3470,6 +3478,11 @@ win32_symlink(const char *oldfile, const char *newfile)
         create_flags |= SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE;
     }
 
+    if (!pCreateSymbolicLinkA) {
+        errno = ENOSYS;
+        return -1;
+    }
+
     /* oldfile might be relative and we don't want to change that,
        so don't map that.
     */
@@ -3514,7 +3527,7 @@ win32_symlink(const char *oldfile, const char *newfile)
         create_flags |= SYMBOLIC_LINK_FLAG_DIRECTORY;
     }
 
-    if (!CreateSymbolicLinkA(newfile, oldfile, create_flags)) {
+    if (!pCreateSymbolicLinkA(newfile, oldfile, create_flags)) {
         translate_to_errno();
         return -1;
     }