From f74b7b511d9e127a1e400158edba39390bd80eec Mon Sep 17 00:00:00 2001 From: Igor Todorovski Date: Wed, 14 May 2025 17:17:17 -0600 Subject: [PATCH 1/5] Add os390.c z/OS has extra startup needs like a couple other platforms, e.g. cygwin. This adds a file that handles them. Principally, z/OS files have extra status fields regarding "tags". Files on this system may be encoded in different character sets, and these fields describe them. Hence the OS has within it the knowledge of a file's encoding. A file is "tagged" as being in a particular encoding (or encodings plural; I have no idea how that works). This file adds a function to deal with them. --- MANIFEST | 1 + os390/os390.c | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+) create mode 100644 os390/os390.c diff --git a/MANIFEST b/MANIFEST index d9153e9c8016..8bff64a39e91 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5665,6 +5665,7 @@ os2/os2thread.h pthread-like typedefs os2/perl2cmd.pl Corrects installed binaries under OS/2 os2/perlrexx.c Support perl interpreter embedded in REXX os2/perlrexx.cmd Test perl interpreter embedded in REXX +os390/os390.c z/OS specific code plan9/9front.patch Plan9 port: patch for 9front-specific flavor of Plan 9 plan9/aperl Plan9 port: shell to make Perl error messages Acme-friendly plan9/arpa/inet.h Plan9 port: replacement C header file diff --git a/os390/os390.c b/os390/os390.c new file mode 100644 index 000000000000..9831b8b0dfc0 --- /dev/null +++ b/os390/os390.c @@ -0,0 +1,57 @@ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include <_Nascii.h> +#include +#include +#include +#include +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +void +zos_copytags_fd(pTHX_ CV *cv) +{ + dXSARGS; + int ret = 0; + + if (items != 2) + Perl_croak(aTHX_ "Usage: ZOS::Filespec::copytags_fd(f1, f2])"); + + int from_fd = (int)SvIV(ST(0)); + int to_fd = (int)SvIV(ST(1)); + + char path[_XOPEN_PATH_MAX] = {0}; + int rc = w_ioctl(from_fd, _IOCC_GPN, _XOPEN_PATH_MAX, path); + if (rc == 0) { + __e2a_l(path, _XOPEN_PATH_MAX); + } + + struct stat src_statsbuf; + if (stat(path, &src_statsbuf)) { + ret = -1; + } + if (ret != -1) { + ret = __setfdccsid(to_fd, (src_statsbuf.st_tag.ft_txtflag << 16) | src_statsbuf.st_tag.ft_ccsid); + } + + XSRETURN_IV(ret); +} + +void +init_os_extras(void) +{ + dTHX; + char* file = __FILE__; + + newXSproto("ZOS::Filespec::copytags_fd",zos_copytags_fd,file,"$;$"); + + return; +} From a9d9b51c2a0097adf309b7ac396db3a65ad73d10 Mon Sep 17 00:00:00 2001 From: Igor Todorovski Date: Sun, 18 May 2025 08:40:24 -0600 Subject: [PATCH 2/5] Call init_os_extras() on z/OS The previous commit added a file and functions for specially dealing with z/OS. This commit actually calls the start up one. --- perl.c | 2 +- perl.h | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/perl.c b/perl.c index d273a31eb835..e9e5b331ba36 100644 --- a/perl.c +++ b/perl.c @@ -2597,7 +2597,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) if (xsinit) (*xsinit)(aTHX); /* in case linked C routines want magical variables */ -#if defined(VMS) || defined(WIN32) || defined(__CYGWIN__) +#if defined(VMS) || defined(WIN32) || defined(__CYGWIN__) || defined(__MVS__) init_os_extras(); #endif diff --git a/perl.h b/perl.h index 1966fcf4667a..9cabb503a472 100644 --- a/perl.h +++ b/perl.h @@ -4469,7 +4469,7 @@ intrinsic function, see its documents for more details. cBOOL(PerlLIO_setmode(fileno(fp), mode) != -1) #endif -#ifdef __CYGWIN__ +#if defined(__CYGWIN__) || defined(__MVS__) void init_os_extras(void); #endif From 81e6b4ad9e1c4b5b49d1df5df7b051f82911a402 Mon Sep 17 00:00:00 2001 From: Igor Todorovski Date: Sun, 18 May 2025 08:56:02 -0600 Subject: [PATCH 3/5] Restructure handling extra statbuf flags on z/OS z/OS has extra fields which give the character set associated with the object. Previously, there were a bunch of functions called to deal with these. This all falls away if we #ifdef these fields when accessing the structure. --- doio.c | 69 ++++++++++------------------------------------------- installperl | 4 ---- iperlsys.h | 17 ++----------- util.c | 37 ---------------------------- 4 files changed, 14 insertions(+), 113 deletions(-) diff --git a/doio.c b/doio.c index d0681ad6ccbe..f0336aa7a7a1 100644 --- a/doio.c +++ b/doio.c @@ -222,57 +222,6 @@ Perl_PerlLIO_dup2_cloexec(pTHX_ int oldfd, int newfd) #endif } -#if defined(OEMVS) - #if (__CHARSET_LIB == 1) -# include -# include - - static int setccsid(int fd, int ccsid) - { - attrib_t attr; - int rc; - - memset(&attr, 0, sizeof(attr)); - attr.att_filetagchg = 1; - attr.att_filetag.ft_ccsid = ccsid; - attr.att_filetag.ft_txtflag = 1; - - rc = __fchattr(fd, &attr, sizeof(attr)); - return rc; - } - - static void updateccsid(int fd, const char* path, int oflag, int perm) - { - int rc; - if (oflag & O_CREAT) { - rc = setccsid(fd, 819); - } - } - - int asciiopen(const char* path, int oflag) - { - int rc; - int fd = open(path, oflag); - if (fd == -1) { - return fd; - } - updateccsid(fd, path, oflag, -1); - return fd; - } - - int asciiopen3(const char* path, int oflag, int perm) - { - int rc; - int fd = open(path, oflag, perm); - if (fd == -1) { - return fd; - } - updateccsid(fd, path, oflag, perm); - return fd; - } - #endif -#endif - int Perl_PerlLIO_open_cloexec(pTHX_ const char *file, int flag) { @@ -302,9 +251,6 @@ Perl_PerlLIO_open3_cloexec(pTHX_ const char *file, int flag, int perm) } #if defined(OEMVS) - #if (__CHARSET_LIB == 1) - #define TEMP_CCSID 819 - #endif static int Internal_Perl_my_mkstemp_cloexec(char *templte) { PERL_ARGS_ASSERT_MY_MKSTEMP_CLOEXEC; @@ -321,9 +267,6 @@ int Perl_my_mkstemp_cloexec(char *templte) { int tempfd = Internal_Perl_my_mkstemp_cloexec(templte); -# if defined(TEMP_CCSID) - setccsid(tempfd, TEMP_CCSID); -# endif return tempfd; } @@ -1471,6 +1414,10 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) #endif PL_filemode = statbuf.st_mode; fileuid = statbuf.st_uid; +#ifdef __MVS__ + int txtflag = statbuf.st_tag.ft_txtflag; + int ccsid = statbuf.st_tag.ft_ccsid; +#endif filegid = statbuf.st_gid; if (!S_ISREG(PL_filemode)) { ck_warner_d(packWARN(WARN_INPLACE), @@ -1548,6 +1495,9 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv))); if (PL_lastfd >= 0) { (void)PerlLIO_fstat(PL_lastfd,&statbuf); +#ifdef __MVS__ + __setfdccsid(PL_lastfd, (txtflag << 16) | ccsid); +#endif #ifdef HAS_FCHMOD (void)fchmod(PL_lastfd,PL_filemode); #else @@ -2558,6 +2508,11 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) } doshell: PERL_FPU_PRE_EXEC +#if defined(OEMVS) + #if (__CHARSET_LIB == 1) + unsetenv("_TAG_REDIR_ERR"); + #endif +#endif PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL); PERL_FPU_POST_EXEC S_exec_failed(aTHX_ PL_sh_path, fd, do_report); diff --git a/installperl b/installperl index 3c8af53bef63..e2006c5561e1 100755 --- a/installperl +++ b/installperl @@ -284,7 +284,6 @@ else { strip("$installbin/$perl_verbase$ver$exe_ext"); fix_dep_names("$installbin/$perl_verbase$ver$exe_ext"); chmod(0755, "$installbin/$perl_verbase$ver$exe_ext"); - `chtag -r "$installbin/$perl_verbase$ver$exe_ext"` if ($^O eq 'os390'); } # Install library files. @@ -355,7 +354,6 @@ foreach my $file (@corefiles) { } else { chmod($NON_SO_MODE, "$installarchlib/CORE/$file"); } - `chtag -r "$installarchlib/CORE/$file"` if ($^O eq 'os390'); } } @@ -424,7 +422,6 @@ if ($Config{installusrbinperl} && $Config{installusrbinperl} eq 'define' && eval { CORE::link $instperl, $usrbinperl } ) || eval { symlink $expinstperl, $usrbinperl } || copy($instperl, $usrbinperl); - `chtag -r "$usrbinperl"` if ($^O eq 'os390'); $mainperl_is_instperl = 1; } @@ -719,7 +716,6 @@ sub copy_if_diff { my ($atime, $mtime) = (stat $from)[8,9]; utime $atime, $mtime, $to; } - `chtag -r "$to"` if ($^O eq "os390"); 1; } } diff --git a/iperlsys.h b/iperlsys.h index 40b3c19908d1..8857f0a75304 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -770,21 +770,8 @@ struct IPerlLIOInfo # define PerlLIO_lstat(name, buf) PerlLIO_stat((name), (buf)) # endif # define PerlLIO_mktemp(file) mktemp((file)) -# if defined(OEMVS) -# if (__CHARSET_LIB == 1) - int asciiopen(const char* path, int oflag); - int asciiopen3(const char* path, int oflag, int perm); - -# define PerlLIO_open(file, flag) asciiopen((file), (flag)) -# define PerlLIO_open3(file, flag, perm) asciiopen3((file), (flag), (perm)) -# else -# define PerlLIO_open(file, flag) open((file), (flag)) -# define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) -# endif -# else -# define PerlLIO_open(file, flag) open((file), (flag)) -# define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) -# endif +# define PerlLIO_open(file, flag) open((file), (flag)) +# define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) # define PerlLIO_read(fd, buf, count) read((fd), (buf), (count)) # define PerlLIO_rename(old, new) rename((old), (new)) # define PerlLIO_setmode(fd, mode) setmode((fd), (mode)) diff --git a/util.c b/util.c index 982a318011a4..dbbd184bac5c 100644 --- a/util.c +++ b/util.c @@ -2534,12 +2534,6 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) /* Close parent's end of error status pipe (if any) */ if (did_pipes) PerlLIO_close(pp[0]); -#if defined(OEMVS) - #if (__CHARSET_LIB == 1) - chgfdccsid(p[THIS], 819); - chgfdccsid(p[THAT], 819); - #endif -#endif /* Now dup our end of _the_ pipe to right position */ if (p[THIS] != (*mode == 'r')) { PerlLIO_dup2(p[THIS], *mode == 'r'); @@ -2615,20 +2609,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) } if (did_pipes) PerlLIO_close(pp[0]); -#if defined(OEMVS) - #if (__CHARSET_LIB == 1) - PerlIO* io = PerlIO_fdopen(p[This], mode); - if (io) { - chgfdccsid(p[This], 819); - } - return io; - #else - return PerlIO_fdopen(p[This], mode); - #endif -#else return PerlIO_fdopen(p[This], mode); -#endif - #else # if defined(OS2) /* Same, without fork()ing and all extra overhead... */ return my_syspopen4(aTHX_ NULL, mode, n, args); @@ -2706,12 +2687,6 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) #define THAT This if (did_pipes) PerlLIO_close(pp[0]); -#if defined(OEMVS) - #if (__CHARSET_LIB == 1) - chgfdccsid(p[THIS], 819); - chgfdccsid(p[THAT], 819); - #endif -#endif if (p[THIS] != (*mode == 'r')) { PerlLIO_dup2(p[THIS], *mode == 'r'); PerlLIO_close(p[THIS]); @@ -2798,19 +2773,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) } if (did_pipes) PerlLIO_close(pp[0]); -#if defined(OEMVS) - #if (__CHARSET_LIB == 1) - PerlIO* io = PerlIO_fdopen(p[This], mode); - if (io) { - chgfdccsid(p[This], 819); - } - return io; - #else return PerlIO_fdopen(p[This], mode); - #endif -#else - return PerlIO_fdopen(p[This], mode); -#endif } #elif defined(__LIBCATAMOUNT__) PerlIO * From 7398dcc53f899cc6d54ccb90d32c4ed22096b2af Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 18 May 2025 12:23:54 -0600 Subject: [PATCH 4/5] Allow z/OS to work in either EBCDIC or ASCII mode IBM has an initiative underway to port various open source projects to work on z/OS, running under ASCII. But its native character set is IBM 1047. This requires a bunch of fancy footwork that they have undertaken. One of the necessary things is to be able to set the character set of a file descriptor. The __setfdccsid() function does that, but it and its header file, zos.h, are only defined in ASCII builds. This commit allows perl to work in both modes. --- os390/os390.c | 1 - perl.h | 9 +++++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/os390/os390.c b/os390/os390.c index 9831b8b0dfc0..2d34a5f7b365 100644 --- a/os390/os390.c +++ b/os390/os390.c @@ -11,7 +11,6 @@ #include #include #include -#include #include "EXTERN.h" #include "perl.h" #include "XSUB.h" diff --git a/perl.h b/perl.h index 9cabb503a472..6250ced643ee 100644 --- a/perl.h +++ b/perl.h @@ -4470,7 +4470,16 @@ intrinsic function, see its documents for more details. #endif #if defined(__CYGWIN__) || defined(__MVS__) + void init_os_extras(void); + +#endif +#if defined(__MVS__) +# ifdef EBCDIC +# define __setfdccsid(to_fd, bits) 0 +# else +# include +# endif #endif union any { From 977ad5e4b60cce29d5b9df14072eaa3cad7fc399 Mon Sep 17 00:00:00 2001 From: Igor Todorovski Date: Wed, 14 May 2025 17:15:35 -0600 Subject: [PATCH 5/5] File/Copy.pm: Copy file tags on z/OS --- lib/File/Copy.pm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index 9b2e12ead8f8..34c79e9a87f6 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -5,7 +5,7 @@ # Additions copyright 1996 by Charles Bailey. Permission is granted # to distribute the revised code under the same terms as Perl itself. -package File::Copy 2.42; +package File::Copy 2.43; use v5.40; no warnings 'newline'; @@ -165,6 +165,11 @@ sub copy { $closeto = 1; } + # Copy file tags on os390 + if ($^O eq 'os390') { + ZOS::Filespec::copytags_fd(fileno($from_h), fileno($to_h)); + } + $! = 0; for (;;) { my ($r, $w, $t);