Craig, Ken,
Can you review this patch?
Part 1, vms.patch
In vms.c:
setup_cmddsc needed a fix to handle Unix executable images when
ODS-5 parsing rules are active.
Those rules translate './perl' to be '[]perl.' and the code to
look up images needs the trailing '.' removed.
This was required for [.vms]test.com to work when the DECC$
feature settings are in UNIX compatibility mode.
Perl_my_symlink, when in the default mode needs to force the
symbolic link target to be in UNIX format. Targets in VMS
format are not recognized by the VMS filesystem.
mp_do_vmsrealpath, needs to have special handling for
non-existent file specifications.
Traditional VMS mode expects a syntax only translation.
UNIX compatible mode needs to do a realpath() operation
on the parent directory if it exists and then append the
filename to it.
In iperlsys.h :
Investigating a failure of [.ext.file.glob.t]global.t showed
that the bsd_glob module was using the CRTL opendir() and
and related files instead of the ones in VMS.C
vmsish.h
Changes required by the above.
Part 2, cwd.patch
Because vms.c is now causing the symbolic link target in cwd.t
to be in UNIX syntax and actually work, the test is failing as
cwd.pm is using readlink() to attempt to resolve the path back
to the original VMS syntax.
Fix cwd.pm to use the unixrealpath and vmsrealpath routines if
if they exist.
Fix cwd.t to be able to detect when cwd.pm returns the
correct results.
I am now shifting my focus to getting as much of the Perl tests to pass
when the DECC feature logicals are in UNIX compatibility mode, as this
is required to natively build some of the open source projects that I am
interested in.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/lib/cwd.pm Sun Oct 19 05:26:56 2008
+++ lib/cwd.pm Wed Oct 22 23:56:34 2008
@@ -647,23 +647,15 @@
return $ENV{'DEFAULT'} unless @_;
my $path = shift;
- if (-l $path) {
- my $link_target = readlink($path);
- die "Can't resolve link $path: $!" unless defined $link_target;
-
- return _vms_abs_path($link_target);
- }
-
- if (defined &VMS::Filespec::vms_realpath) {
- my $path = $_[0];
+ if (defined &VMS::Filespec::vmsrealpath) {
if ($path =~ m#(?<=\^)/# ) {
# Unix format
- return VMS::Filespec::vms_realpath($path);
+ return VMS::Filespec::unixrealpath($path);
}
# VMS format
- my $new_path = VMS::Filespec::vms_realname($path);
+ my $new_path = VMS::Filespec::vmsrealpath($path);
# Perl expects directories to be in directory format
$new_path = VMS::Filespec::pathify($new_path) if -d $path;
@@ -673,6 +665,13 @@
# Fallback to older algorithm if correct ones are not
# available.
+ if (-l $path) {
+ my $link_target = readlink($path);
+ die "Can't resolve link $path: $!" unless defined $link_target;
+
+ return _vms_abs_path($link_target);
+ }
+
# may need to turn foo.dir into [.foo]
my $pathified = VMS::Filespec::pathify($path);
$path = $pathified if defined $pathified;
--- /rsync_root/perl/ext/cwd/t/cwd.t Tue Jan 22 22:17:18 2008
+++ ext/cwd/t/cwd.t Wed Oct 22 23:32:36 2008
@@ -173,6 +173,15 @@
$ENV{PERL_CORE} ? $Test_Dir :
File::Spec->catdir('t', $Test_Dir)
)
);
+ if ($^O eq 'VMS') {
+ # Not easy to predict the physical volume name
+ $want = $ENV{PERL_CORE} ? $Test_Dir : File::Spec->catdir('t',
$Test_Dir);
+
+ # So just use the relative volume name
+ $want =~ s/^\[//;
+
+ $want = quotemeta($want);
+ }
like($abs_path, qr|$want$|i);
like($fast_abs_path, qr|$want$|i);
--- /rsync_root/perl/iperlsys.h Mon Feb 25 11:47:31 2008
+++ iperlsys.h Wed Oct 22 00:51:02 2008
@@ -433,16 +433,23 @@
#define PerlDir_mkdir(name, mode) Mkdir((name), (mode))
#ifdef VMS
# define PerlDir_chdir(n) Chdir((n))
+# define PerlDir_rmdir(name) do_rmdir((name))
+# define PerlDir_close(dir) vms_closedir((dir))
+# define PerlDir_open(name) vms_opendir((name))
+# define PerlDir_read(dir) vms_readdir((dir))
+# define PerlDir_rewind(dir) vms_rewinddir((dir))
+# define PerlDir_seek(dir, loc) vms_seekdir((dir), (loc))
+# define PerlDir_tell(dir) vms_telldir((dir))
#else
# define PerlDir_chdir(name) chdir((name))
+# define PerlDir_rmdir(name) rmdir((name))
+# define PerlDir_close(dir) closedir((dir))
+# define PerlDir_open(name) opendir((name))
+# define PerlDir_read(dir) readdir((dir))
+# define PerlDir_rewind(dir) rewinddir((dir))
+# define PerlDir_seek(dir, loc) seekdir((dir), (loc))
+# define PerlDir_tell(dir) telldir((dir))
#endif
-#define PerlDir_rmdir(name) rmdir((name))
-#define PerlDir_close(dir) closedir((dir))
-#define PerlDir_open(name) opendir((name))
-#define PerlDir_read(dir) readdir((dir))
-#define PerlDir_rewind(dir) rewinddir((dir))
-#define PerlDir_seek(dir, loc) seekdir((dir), (loc))
-#define PerlDir_tell(dir) telldir((dir))
#ifdef WIN32
#define PerlDir_mapA(dir) dir
#define PerlDir_mapW(dir) dir
--- /rsync_root/perl/vms/vmsish.h Fri Jun 13 19:00:12 2008
+++ vms/vmsish.h Wed Oct 22 00:54:31 2008
@@ -276,7 +276,7 @@
#define my_endpwent() Perl_my_endpwent(aTHX)
#define my_getlogin Perl_my_getlogin
#ifdef HAS_SYMLINK
-# define my_symlink Perl_my_symlink
+# define my_symlink(a, b) Perl_my_symlink(aTHX_ a, b)
#endif
#define init_os_extras Perl_init_os_extras
#define vms_realpath(a, b, c) Perl_vms_realpath(aTHX_ a,b,c)
@@ -517,7 +517,7 @@
# define fdopen my_fdopen
# define fclose my_fclose
#ifdef HAS_SYMLINK
-# define symlink my_symlink
+# define symlink(a, b) my_symlink(a, b)
#endif
#endif
@@ -641,6 +641,14 @@
/* Tweak arg to mkdir & chdir first, so we can tolerate trailing /. */
#define Mkdir(dir,mode) Perl_my_mkdir(aTHX_ (dir),(mode))
#define Chdir(dir) my_chdir((dir))
+
+/* Need to redirect opendir... */
+#define vms_closedir(dir) Perl_closedir((dir))
+#define vms_opendir(name) Perl_opendir(aTHX_ (name))
+#define vms_readdir(dir) Perl_readdir(aTHX_ (dir))
+#define vms_rewinddir(dir) Perl_seekdir(aTHX_ (dir), 0)
+#define vms_seekdir(dir, loc) Perl_seekdir(aTHX_ (dir), (loc))
+#define vms_telldir(dir) Perl_telldir((dir))
#ifndef DONT_MASK_RTL_CALLS
#define chmod(file_spec, mode) my_chmod((file_spec), (mode))
#endif
@@ -970,7 +978,7 @@
int my_fclose (FILE *);
int my_fwrite (const void *, size_t, size_t, FILE *);
#ifdef HAS_SYMLINK
-int my_symlink(const char *path1, const char *path2);
+int Perl_my_symlink(pTHX_ const char *path1, const char *path2);
#endif
int Perl_my_flush (pTHX_ FILE *);
struct passwd * Perl_my_getpwnam (pTHX_ const char *name);
--- /rsync_root/perl/vms/vms.c Wed Oct 22 19:26:20 2008
+++ vms/vms.c Wed Oct 22 22:38:19 2008
@@ -9892,6 +9892,19 @@
*cp2 = '\0';
if (do_tovmsspec(resspec,cp,0,NULL)) {
s = vmsspec;
+
+ /* When a UNIX spec with no file type is translated to VMS, */
+ /* A trailing '.' is appended under ODS-5 rules. */
+ /* Here we do not want that trailing "." as it prevents */
+ /* Looking for a implied ".exe" type. */
+ if (decc_efs_charset) {
+ int i;
+ i = strlen(vmsspec);
+ if (vmsspec[i-1] == '.') {
+ vmsspec[i-1] = '\0';
+ }
+ }
+
if (*rest) {
for (cp2 = vmsspec + strlen(vmsspec);
*rest && cp2 - vmsspec < sizeof vmsspec;
@@ -12990,14 +13003,41 @@
/*
* A thin wrapper around decc$symlink to make sure we follow the
* standard and do not create a symlink with a zero-length name.
+ *
+ * Also in ODS-2 mode, existing tests assume that the link target
+ * will be converted to UNIX format.
*/
-/*{{{ int my_symlink(const char *path1, const char *path2)*/
-int my_symlink(const char *path1, const char *path2) {
- if (!path2 || !*path2) {
+/*{{{ int my_symlink(pTHX_ const char *contents, const char *link_name)*/
+int Perl_my_symlink(pTHX_ const char *contents, const char *link_name) {
+ if (!link_name || !*link_name) {
SETERRNO(ENOENT, SS$_NOSUCHFILE);
return -1;
}
- return symlink(path1, path2);
+
+ if (decc_efs_charset) {
+ return symlink(contents, link_name);
+ } else {
+ int sts;
+ char * utarget;
+
+ /* Unless we are in ODS-5 mode, convert the symlink target to UNIX */
+ /* because in order to work, the symlink target must be in UNIX format */
+
+ /* As symbolic links can hold things other than files, we will only do */
+ /* the conversion in in ODS-2 mode */
+
+ Newx(utarget, VMS_MAXRSS + 1, char);
+ if (do_tounixspec(contents, utarget, 0, NULL) == NULL) {
+
+ /* This should not fail, as an untranslatable filename */
+ /* should be passed through */
+ utarget = (char *)contents;
+ }
+ sts = symlink(utarget, link_name);
+ Safefree(utarget);
+ return sts;
+ }
+
}
/*}}}*/
@@ -13203,6 +13243,100 @@
if (haslower) __mystrtolower(rslt);
}
}
+ } else {
+
+ /* Now for some hacks to deal with backwards and forward */
+ /* compatibilty */
+ if (!decc_efs_charset) {
+
+ /* 1. ODS-2 mode wants to do a syntax only translation */
+ rslt = do_rmsexpand(filespec, outbuf,
+ 0, NULL, 0, NULL, utf8_fl);
+
+ } else {
+ if (decc_filename_unix_report) {
+ char * dir_name;
+ char * vms_dir_name;
+ char * file_name;
+
+ /* 2. ODS-5 / UNIX report mode should return a failure */
+ /* if the parent directory also does not exist */
+ /* Otherwise, get the real path for the parent */
+ /* and add the child to it.
+
+ /* basename / dirname only available for VMS 7.0+ */
+ /* So we may need to implement them as common routines */
+
+ Newx(dir_name, VMS_MAXRSS + 1, char);
+ Newx(vms_dir_name, VMS_MAXRSS + 1, char);
+ dir_name[0] = '\0';
+ file_name = NULL;
+
+ /* First try a VMS parse */
+ sts = vms_split_path
+ (filespec,
+ &v_spec,
+ &v_len,
+ &r_spec,
+ &r_len,
+ &d_spec,
+ &d_len,
+ &n_spec,
+ &n_len,
+ &e_spec,
+ &e_len,
+ &vs_spec,
+ &vs_len);
+
+ if (sts == 0) {
+ /* This is VMS */
+
+ int dir_len = v_len + r_len + d_len + n_len;
+ if (dir_len > 0) {
+ strncpy(dir_name, filespec, dir_len);
+ dir_name[dir_len] = '\0';
+ file_name = (char *)&filespec[dir_len + 1];
+ }
+ } else {
+ /* This must be UNIX */
+ char * tchar;
+
+ tchar = strrchr(filespec, '/');
+
+ if (tchar != NULL) {
+ int dir_len = tchar - filespec;
+ strncpy(dir_name, filespec, dir_len);
+ dir_name[dir_len] = '\0';
+ file_name = (char *) &filespec[dir_len + 1];
+ }
+ }
+
+ /* Dir name is defaulted */
+ if (dir_name[0] == 0) {
+ dir_name[0] = '.';
+ dir_name[1] = '\0';
+ }
+
+ /* Need realpath for the directory */
+ sts = vms_fid_to_name(vms_dir_name,
+ VMS_MAXRSS + 1,
+ dir_name);
+
+ if (sts == 0) {
+ /* Now need to pathify it.
+ char *tdir = do_pathify_dirspec(vms_dir_name,
+ outbuf, utf8_fl);
+
+ /* And now add the original filespec to it */
+ if (file_name != NULL) {
+ strcat(outbuf, file_name);
+ }
+ return outbuf;
+ }
+ Safefree(vms_dir_name);
+ Safefree(dir_name);
+ }
+ }
}
Safefree(vms_spec);
