diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | iperlsys.h | 12 | ||||
| -rw-r--r-- | pod/perlport.pod | 16 | ||||
| -rw-r--r-- | pp_sys.c | 6 | ||||
| -rw-r--r-- | t/op/stat.t | 6 | ||||
| -rw-r--r-- | t/win32/symlink.t | 77 | ||||
| -rw-r--r-- | win32/Makefile | 4 | ||||
| -rw-r--r-- | win32/config.gc | 4 | ||||
| -rw-r--r-- | win32/config.vc | 4 | ||||
| -rw-r--r-- | win32/config_H.gc | 6 | ||||
| -rw-r--r-- | win32/config_H.vc | 6 | ||||
| -rw-r--r-- | win32/perlhost.h | 14 | ||||
| -rw-r--r-- | win32/win32.c | 183 | ||||
| -rw-r--r-- | win32/win32iop.h | 7 |
14 files changed, 292 insertions, 54 deletions
@@ -6165,6 +6165,7 @@ t/win32/popen.t Test for stdout races in backticks, etc t/win32/runenv.t Test if Win* perl honors its env variables t/win32/signal.t Test Win32 signal emulation t/win32/stat.t Test Win32 stat emulation +t/win32/symlink.t Test Win32 symlink t/win32/system.t See if system works in Win* t/win32/system_tests Test runner for system.t taint.c Tainting code diff --git a/iperlsys.h b/iperlsys.h index c176ad5c55..28091141e6 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -654,6 +654,10 @@ typedef int (*LPLIOUnlink)(struct IPerlLIO*, const char*); typedef int (*LPLIOUtime)(struct IPerlLIO*, const char*, struct utimbuf*); typedef int (*LPLIOWrite)(struct IPerlLIO*, int, const void*, unsigned int); +typedef int (*LPLIOSymLink)(struct IPerlLIO*, const char*, + const char *); +typedef int (*LPLIOReadLink)(struct IPerlLIO*, const char*, + char *, size_t); struct IPerlLIO { @@ -683,6 +687,8 @@ struct IPerlLIO LPLIOUnlink pUnlink; LPLIOUtime pUtime; LPLIOWrite pWrite; + LPLIOSymLink pSymLink; + LPLIOReadLink pReadLink; }; struct IPerlLIOInfo @@ -715,6 +721,10 @@ struct IPerlLIOInfo (*PL_LIO->pIsatty)(PL_LIO, (fd)) #define PerlLIO_link(oldname, newname) \ (*PL_LIO->pLink)(PL_LIO, (oldname), (newname)) +#define PerlLIO_symlink(oldname, newname) \ + (*PL_LIO->pSymLink)(PL_LIO, (oldname), (newname)) +#define PerlLIO_readlink(path, buf, bufsiz) \ + (*PL_LIO->pReadLink)(PL_LIO, (path), (buf), (bufsiz)) #define PerlLIO_lseek(fd, offset, mode) \ (*PL_LIO->pLseek)(PL_LIO, (fd), (offset), (mode)) #define PerlLIO_lstat(name, buf) \ @@ -764,6 +774,8 @@ struct IPerlLIOInfo #define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf)) #define PerlLIO_isatty(fd) isatty((fd)) #define PerlLIO_link(oldname, newname) link((oldname), (newname)) +#define PerlLIO_symlink(oldname, newname) symlink((oldname), (newname)) +#define PerlLIO_readlink(path, buf, bufsiz) readlink((path), (buf), (bufsiz)) #define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode)) #define PerlLIO_stat(name, buf) Stat((name), (buf)) #ifdef HAS_LSTAT diff --git a/pod/perlport.pod b/pod/perlport.pod index a9809802fd..224d3babbd 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -1571,6 +1571,12 @@ filehandle may be closed, or pointer may be in a different position. The value returned by L<C<tell>|perlfunc/tell FILEHANDLE> may be affected after the call, and the filehandle may be flushed. +=item chdir + +(Win32) +The current directory reported by the system may include any symbolic +links specified to chdir(). + =item chmod (Win32) @@ -2100,9 +2106,17 @@ true value speeds up C<stat> by not performing this operation. =item symlink -(Win32, S<RISC OS>) +(S<RISC OS>) Not implemented. +(Win32) + +Requires either elevated permissions or developer mode and a +sufficiently recent version of Windows 10. Since Windows needs to +know whether the target is a directory or not when creating the link +the target Perl will only create the link as a directory link when the +target exists and is a directory. + (VMS) Implemented on 64 bit VMS 8.3. VMS requires the symbolic link to be in Unix syntax if it is intended to resolve to a valid path. @@ -3774,13 +3774,13 @@ PP(pp_link) # if defined(HAS_LINK) && defined(HAS_SYMLINK) /* Both present - need to choose which. */ (op_type == OP_LINK) ? - PerlLIO_link(tmps, tmps2) : symlink(tmps, tmps2); + PerlLIO_link(tmps, tmps2) : PerlLIO_symlink(tmps, tmps2); # elif defined(HAS_LINK) /* Only have link, so calls to pp_symlink will have DIE()d above. */ PerlLIO_link(tmps, tmps2); # elif defined(HAS_SYMLINK) /* Only have symlink, so calls to pp_link will have DIE()d above. */ - symlink(tmps, tmps2); + PerlLIO_symlink(tmps, tmps2); # endif } @@ -3811,7 +3811,7 @@ PP(pp_readlink) tmps = POPpconstx; /* NOTE: if the length returned by readlink() is sizeof(buf) - 1, * it is impossible to know whether the result was truncated. */ - len = readlink(tmps, buf, sizeof(buf) - 1); + len = PerlLIO_readlink(tmps, buf, sizeof(buf) - 1); if (len < 0) RETPUSHUNDEF; buf[len] = '\0'; diff --git a/t/op/stat.t b/t/op/stat.t index 1cf6072f6e..099a3f1e98 100644 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -27,6 +27,8 @@ if ($^O eq 'MSWin32') { ${^WIN32_SLOPPY_STAT} = 0; } +my $Errno_loaded = eval { require Errno }; + plan tests => 110; my $Perl = which_perl(); @@ -241,7 +243,10 @@ ok(! -f '.', '!-f cwd' ); SKIP: { unlink($tmpfile_link); my $symlink_rslt = eval { symlink $tmpfile, $tmpfile_link }; + my $error = 0 + $!; skip "symlink not implemented", 3 if $@ =~ /unimplemented/; + skip "symlink not available or we can't check", 3 + if $^O eq "MSWin32" && (!$Errno_loaded || $error == &Errno::ENOSYS || $error == &Errno::EPERM); is( $@, '', 'symlink() implemented' ); ok( $symlink_rslt, 'symlink() ok' ); @@ -634,7 +639,6 @@ SKIP: { skip "There is a file named '2', which invalidates this test", 2 if -e '2'; - my $Errno_loaded = eval { require Errno }; my @statarg = ($statfile, $statfile); no warnings 'syntax'; ok !stat(@statarg), diff --git a/t/win32/symlink.t b/t/win32/symlink.t new file mode 100644 index 0000000000..9716f3789c --- /dev/null +++ b/t/win32/symlink.t @@ -0,0 +1,77 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require "./test.pl"; +} + +use Errno; + +Win32::FsType() eq 'NTFS' + or skip_all("need NTFS"); + +plan skip_all => "no symlink available in this Windows" + if !symlink('', '') && $! == &Errno::ENOSYS; + +my $tmpfile1 = tempfile(); +my $tmpfile2 = tempfile(); + +my $ok = symlink($tmpfile1, $tmpfile2); +plan skip_all => "no access to symlink as this user" + if !$ok && $! == &Errno::EPERM; + +ok($ok, "create a dangling symbolic link"); +ok(-l $tmpfile2, "-l sees it as a symlink"); +ok(unlink($tmpfile2), "and remove it"); + +ok(mkdir($tmpfile1), "make a directory"); +ok(!-l $tmpfile1, "doesn't look like a symlink"); +ok(symlink($tmpfile1, $tmpfile2), "and symlink to it"); +ok(-l $tmpfile2, "which does look like a symlink"); +ok(!-d _, "-d on the lstat result is false"); +ok(-d $tmpfile2, "normal -d sees it as a directory"); +is(readlink($tmpfile2), $tmpfile1, "readlink works"); +check_stat($tmpfile1, $tmpfile2, "check directory and link stat are the same"); +ok(unlink($tmpfile2), "and we can unlink the symlink (rather than only rmdir)"); + +# to check the unlink code for symlinks isn't mis-handling non-symlink +# directories +ok(!unlink($tmpfile1), "we can't unlink the original directory"); + +ok(rmdir($tmpfile1), "we can rmdir it"); + +ok(open(my $fh, ">", $tmpfile1), "make a file"); +close $fh if $fh; +ok(symlink($tmpfile1, $tmpfile2), "link to it"); +ok(-l $tmpfile2, "-l sees a link"); +ok(!-f _, "-f on the lstat result is false"); +ok(-f $tmpfile2, "normal -d sees it as a file"); +is(readlink($tmpfile2), $tmpfile1, "readlink works"); +check_stat($tmpfile1, $tmpfile2, "check file and link stat are the same"); +ok(unlink($tmpfile2), "unlink the symlink"); +ok(unlink($tmpfile1), "and the file"); + +# test we don't treat directory junctions like symlinks +ok(mkdir($tmpfile1), "make a directory"); + +# mklink is available from Vista onwards +# this may only work in an admin shell +# MKLINK [[/D] | [/H] | [/J]] Link Target +if (system("mklink /j $tmpfile2 $tmpfile1") == 0) { + ok(!-l $tmpfile2, "junction doesn't look like a symlink"); + ok(!unlink($tmpfile2), "no unlink magic for junctions"); + rmdir($tmpfile2); +} +rmdir($tmpfile1); + +done_testing(); + +sub check_stat { + my ($file1, $file2, $name) = @_; + + my @stat1 = stat($file1); + my @stat2 = stat($file2); + + is("@stat1", "@stat2", $name); +} diff --git a/win32/Makefile b/win32/Makefile index 93d55f7ca6..41b9fb8bc5 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -960,7 +960,7 @@ regen_config_h: -$(MINIPERL) -I..\lib config_h.PL rename config.h $(CFGH_TMPL) -$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL +$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\git_version.h $(MINIPERL) -I..\lib ..\configpm --chdir=.. $(XCOPY) ..\*.h $(COREDIR)\*.* $(XCOPY) *.h $(COREDIR)\*.* @@ -1100,7 +1100,7 @@ $(WIN32_OBJ) : $(CORE_H) $(CORE_OBJ) : $(CORE_H) $(DLL_OBJ) : $(CORE_H) -perldll.def : $(MINIPERL) $(CONFIGPM) ..\embed.fnc ..\makedef.pl create_perllibst_h.pl +perldll.def : $(MINIPERL) $(CONFIGPM) ..\embed.fnc ..\makedef.pl create_perllibst_h.pl ..\git_version.h $(MINIPERL) -I..\lib create_perllibst_h.pl $(MINIPERL) -I..\lib -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \ CCTYPE=$(CCTYPE) TARG_DIR=..\ > perldll.def diff --git a/win32/config.gc b/win32/config.gc index c7e619620b..9ffec527bf 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -446,7 +446,7 @@ d_random_r='undef' d_readdir64_r='undef' d_readdir='define' d_readdir_r='undef' -d_readlink='undef' +d_readlink='define' d_readv='undef' d_recvmsg='undef' d_regcomp='undef' @@ -571,7 +571,7 @@ d_strtoull='undef' d_strtouq='undef' d_strxfrm='define' d_suidsafe='undef' -d_symlink='undef' +d_symlink='define' d_syscall='undef' d_syscallproto='undef' d_sysconf='undef' diff --git a/win32/config.vc b/win32/config.vc index 294cdacbb2..6d6e675c7a 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -446,7 +446,7 @@ d_random_r='undef' d_readdir64_r='undef' d_readdir='define' d_readdir_r='undef' -d_readlink='undef' +d_readlink='define' d_readv='undef' d_recvmsg='undef' d_regcomp='undef' @@ -571,7 +571,7 @@ d_strtoull='undef' d_strtouq='undef' d_strxfrm='define' d_suidsafe='undef' -d_symlink='undef' +d_symlink='define' d_syscall='undef' d_syscallproto='undef' d_sysconf='undef' diff --git a/win32/config_H.gc b/win32/config_H.gc index a068b08bba..7bfdf11029 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -9,7 +9,7 @@ /* Package name : perl5 * Source directory : - * Configuration time: Wed Oct 7 16:27:47 2020 + * Configuration time: Wed Oct 7 16:35:37 2020 * Configured by : tony * Target system : */ @@ -342,7 +342,7 @@ * This symbol, if defined, indicates that the readlink routine is * available to read the value of a symbolic link. */ -/*#define HAS_READLINK / **/ +#define HAS_READLINK /**/ /* HAS_REGCOMP: * This symbol, if defined, indicates that the regcomp() routine is @@ -500,7 +500,7 @@ * This symbol, if defined, indicates that the symlink routine is available * to create symbolic links. */ -/*#define HAS_SYMLINK / **/ +#define HAS_SYMLINK /**/ /* HAS_SYSCALL: * This symbol, if defined, indicates that the syscall routine is diff --git a/win32/config_H.vc b/win32/config_H.vc index 4b88f66938..49b8ea7935 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -9,7 +9,7 @@ /* Package name : perl5 * Source directory : - * Configuration time: Wed Oct 7 16:25:12 2020 + * Configuration time: Wed Oct 7 16:33:14 2020 * Configured by : tony * Target system : */ @@ -342,7 +342,7 @@ * This symbol, if defined, indicates that the readlink routine is * available to read the value of a symbolic link. */ -/*#define HAS_READLINK / **/ +#define HAS_READLINK /**/ /* HAS_REGCOMP: * This symbol, if defined, indicates that the regcomp() routine is @@ -500,7 +500,7 @@ * This symbol, if defined, indicates that the symlink routine is available * to create symbolic links. */ -/*#define HAS_SYMLINK / **/ +#define HAS_SYMLINK /**/ /* HAS_SYSCALL: * This symbol, if defined, indicates that the syscall routine is diff --git a/win32/perlhost.h b/win32/perlhost.h index d00240f26f..6d12abf252 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -986,6 +986,18 @@ PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname) return win32_link(oldname, newname); } +int +PerlLIOSymLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname) +{ + return win32_symlink(oldname, newname); +} + +int +PerlLIOReadLink(struct IPerlLIO* piPerl, const char *path, char *buf, size_t bufsiz) +{ + return win32_readlink(path, buf, bufsiz); +} + Off_t PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin) { @@ -1098,6 +1110,8 @@ const struct IPerlLIO perlLIO = PerlLIOUnlink, PerlLIOUtime, PerlLIOWrite, + PerlLIOSymLink, + PerlLIOReadLink }; diff --git a/win32/win32.c b/win32/win32.c index b757715647..162ef62de0 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1697,6 +1697,81 @@ is_symlink(HANDLE h) { return TRUE; } +static BOOL +is_symlink_name(const char *name) { + HANDLE f = CreateFileA(name, GENERIC_READ, 0, NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, 0); + BOOL result; + + if (f == INVALID_HANDLE_VALUE) { + return FALSE; + } + result = is_symlink(f); + CloseHandle(f); + + return result; +} + +DllExport int +win32_readlink(const char *pathname, char *buf, size_t bufsiz) { + MY_REPARSE_DATA_BUFFER linkdata; + const MY_SYMLINK_REPARSE_BUFFER * const sd = + &linkdata.Data.SymbolicLinkReparseBuffer; + HANDLE hlink; + DWORD fileattr = GetFileAttributes(pathname); + DWORD linkdata_returned; + int bytes_out; + BOOL used_default; + + if (fileattr == INVALID_FILE_ATTRIBUTES) { + translate_to_errno(); + return -1; + } + + if (!(fileattr & FILE_ATTRIBUTE_REPARSE_POINT)) { + /* not a symbolic link */ + errno = EINVAL; + return -1; + } + + hlink = + CreateFileA(pathname, GENERIC_READ, 0, NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, 0); + if (hlink == INVALID_HANDLE_VALUE) { + translate_to_errno(); + return -1; + } + + if (!DeviceIoControl(hlink, FSCTL_GET_REPARSE_POINT, NULL, 0, &linkdata, sizeof(linkdata), &linkdata_returned, NULL)) { + translate_to_errno(); + CloseHandle(hlink); + return -1; + } + CloseHandle(hlink); + + if (linkdata_returned < offsetof(MY_REPARSE_DATA_BUFFER, Data.SymbolicLinkReparseBuffer.PathBuffer) + || linkdata.ReparseTag != IO_REPARSE_TAG_SYMLINK) { + errno = EINVAL; + return -1; + } + + bytes_out = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, + sd->PathBuffer+sd->SubstituteNameOffset/2, + sd->SubstituteNameLength/2, + buf, bufsiz, NULL, &used_default); + if (bytes_out == 0 || used_default) { + /* failed conversion from unicode to ANSI or otherwise failed */ + errno = EINVAL; + return -1; + } + if ((size_t)bytes_out > bufsiz) { + errno = EINVAL; + return -1; + } + + return bytes_out; +} + DllExport int win32_lstat(const char *path, Stat_t *sbuf) { @@ -2129,8 +2204,14 @@ win32_unlink(const char *filename) if (ret == -1) (void)SetFileAttributesA(filename, attrs); } - else + else if ((attrs & (FILE_ATTRIBUTE_REPARSE_POINT | FILE_ATTRIBUTE_DIRECTORY)) + == (FILE_ATTRIBUTE_REPARSE_POINT | FILE_ATTRIBUTE_DIRECTORY) + && is_symlink_name(filename)) { + ret = rmdir(filename); + } + else { ret = unlink(filename); + } return ret; } @@ -3341,44 +3422,74 @@ win32_link(const char *oldname, const char *newname) { return 0; } - /* This isn't perfect, eg. Win32 returns ERROR_ACCESS_DENIED for - both permissions errors and if the source is a directory, while - POSIX wants EACCES and EPERM respectively. + translate_to_errno(); + return -1; +} - Determined by experimentation on Windows 7 x64 SP1, since MS - don't document what error codes are returned. +#ifndef SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE +# define SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE 0x2 +#endif + +DllExport int +win32_symlink(const char *oldfile, const char *newfile) +{ + dTHX; + const char *dest_path = oldfile; + char szTargetName[MAX_PATH+1]; + size_t oldfile_len = strlen(oldfile); + DWORD dest_attr; + DWORD create_flags = SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE; + + /* oldfile might be relative and we don't want to change that, + so don't map that. */ - switch (GetLastError()) { - case ERROR_BAD_NET_NAME: - case ERROR_BAD_NETPATH: - case ERROR_BAD_PATHNAME: - case ERROR_FILE_NOT_FOUND: - case ERROR_FILENAME_EXCED_RANGE: - case ERROR_INVALID_DRIVE: - case ERROR_PATH_NOT_FOUND: - errno = ENOENT; - break; - case ERROR_ALREADY_EXISTS: - errno = EEXIST; - break; - case ERROR_ACCESS_DENIED: - errno = EACCES; - break; - case ERROR_NOT_SAME_DEVICE: - errno = EXDEV; - break; - case ERROR_DISK_FULL: - errno = ENOSPC; - break; - case ERROR_NOT_ENOUGH_QUOTA: - errno = EDQUOT; - break; - default: - /* ERROR_INVALID_FUNCTION - eg. on a FAT volume */ - errno = EINVAL; - break; + newfile = PerlDir_mapA(newfile); + + /* are we linking to a directory? + CreateSymlinkA() needs to know if the target is a directory, + if the oldfile is relative we need to make a relative path + based on the newfile + */ + if (oldfile_len >= 3 && oldfile[1] == ':' && oldfile[2] != '\\' && oldfile[2] != '/') { + /* relative to current directory on a drive */ + /* dest_path = oldfile; already done */ + } + else if (oldfile[0] != '\\' && oldfile[0] != '/') { + size_t newfile_len = strlen(newfile); + char *last_slash = strrchr(newfile, '/'); + char *last_bslash = strrchr(newfile, '\\'); + char *end_dir = last_slash && last_bslash + ? ( last_slash > last_bslash ? last_slash : last_bslash) + : last_slash ? last_slash : last_bslash ? last_bslash : NULL; + + if (end_dir) { + if ((end_dir - newfile + 1) + oldfile_len > MAX_PATH) { + /* too long */ + errno = EINVAL; + return -1; + } + + memcpy(szTargetName, newfile, end_dir - newfile + 1); + strcpy(szTargetName + (end_dir - newfile + 1), oldfile); + dest_path = szTargetName; + } + else { + /* newpath is just a filename */ + /* dest_path = oldfile; */ + } } - return -1; + + dest_attr = GetFileAttributes(dest_path); + if (dest_attr != (DWORD)-1 && (dest_attr & FILE_ATTRIBUTE_DIRECTORY)) { + create_flags |= SYMBOLIC_LINK_FLAG_DIRECTORY; + } + + if (!CreateSymbolicLinkA(newfile, oldfile, create_flags)) { + translate_to_errno(); + return -1; + } + + return 0; } DllExport int diff --git a/win32/win32iop.h b/win32/win32iop.h index 84fe1e5e5c..80a34f81a9 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -137,6 +137,8 @@ DllExport char* win32_longpath(char *path); DllExport char* win32_ansipath(const WCHAR *path); DllExport int win32_ioctl(int i, unsigned int u, char *data); DllExport int win32_link(const char *oldname, const char *newname); +DllExport int win32_symlink(const char *oldname, const char *newname); +DllExport int win32_readlink(const char *path, char *buf, size_t bufsiz); DllExport int win32_unlink(const char *f); DllExport int win32_utime(const char *f, struct utimbuf *t); DllExport int win32_gettimeofday(struct timeval *tp, void *not_used); @@ -286,7 +288,8 @@ END_EXTERN_C #define putchar win32_putchar #define access(p,m) win32_access(p,m) #define chmod(p,m) win32_chmod(p,m) - +#define symlink(targ,realp) win32_symlink(targ,realp) +#define readlink(p,buf,bufsiz) win32_readlink(p,buf,bufsiz) #if !defined(MYMALLOC) || !defined(PERL_CORE) #undef malloc @@ -309,6 +312,8 @@ END_EXTERN_C #define times win32_times #define ioctl win32_ioctl #define link win32_link +#define symlink win32_symlink +#define readlink win32_readlink #define unlink win32_unlink #define utime win32_utime #define gettimeofday win32_gettimeofday |