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/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/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); diff --git a/os390/os390.c b/os390/os390.c new file mode 100644 index 000000000000..2d34a5f7b365 --- /dev/null +++ b/os390/os390.c @@ -0,0 +1,56 @@ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include <_Nascii.h> +#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; +} 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..6250ced643ee 100644 --- a/perl.h +++ b/perl.h @@ -4469,8 +4469,17 @@ 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 +#if defined(__MVS__) +# ifdef EBCDIC +# define __setfdccsid(to_fd, bits) 0 +# else +# include +# endif #endif union any { 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 *