diff options
| -rw-r--r-- | vms/vms.c | 17 | ||||
| -rw-r--r-- | vms/vmsish.h | 11 |
2 files changed, 26 insertions, 2 deletions
@@ -12721,7 +12721,22 @@ vms_realpath_fromperl(pTHX_ CV *cv) Safefree(rslt_spec); XSRETURN(1); } -#endif + +/* + * A thin wrapper around decc$symlink to make sure we follow the + * standard and do not create a symlink with a zero-length name. + */ +/*{{{ int my_symlink(const char *path1, const char *path2)*/ +int my_symlink(const char *path1, const char *path2) { + if (!path2 || !*path2) { + SETERRNO(ENOENT, SS$_NOSUCHFILE); + return -1; + } + return symlink(path1, path2); +} +/*}}}*/ + +#endif /* HAS_SYMLINK */ #if __CRTL_VER >= 70301000 && !defined(__VAX) int do_vms_case_tolerant(void); diff --git a/vms/vmsish.h b/vms/vmsish.h index a0a52a3f86..178934e1bb 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -274,6 +274,9 @@ #define my_getpwent() Perl_my_getpwent(aTHX) #define my_endpwent() Perl_my_endpwent(aTHX) #define my_getlogin Perl_my_getlogin +#ifdef HAS_SYMLINK +# define my_symlink Perl_my_symlink +#endif #define init_os_extras Perl_init_os_extras #define vms_realpath(a, b, c) Perl_vms_realpath(aTHX_ a,b,c) #define vms_case_tolerant(a) Perl_vms_case_tolerant(a) @@ -507,6 +510,9 @@ struct interp_intern { # define fwrite my_fwrite /* for PerlSIO_fwrite */ # define fdopen my_fdopen # define fclose my_fclose +#ifdef HAS_SYMLINK +# define symlink my_symlink +#endif #endif @@ -958,7 +964,10 @@ unsigned long int Perl_do_aspawn (pTHX_ void *, void **, void **); unsigned long int Perl_do_spawn (pTHX_ const char *); FILE * my_fdopen (int, const char *); int my_fclose (FILE *); -int my_fwrite (const void *, size_t, size_t, FILE *); +int my_fwrite (const void *, size_t, size_t, FILE *); +#ifdef HAS_SYMLINK +int my_symlink(const char *path1, const char *path2); +#endif int Perl_my_flush (pTHX_ FILE *); struct passwd * Perl_my_getpwnam (pTHX_ const char *name); struct passwd * Perl_my_getpwuid (pTHX_ Uid_t uid); |