# define SS$_NOSUCHOBJECT 2696
#endif
-/* Don't intercept calls to vfork, since my_vfork below needs to
- * get to the underlying CRTL routine. */
-#define __DONT_MASK_VFORK
+/* Don't replace system definitions of vfork, getenv, and stat,
+ * code below needs to get to the underlying CRTL routines. */
+#define DONT_MASK_RTL_CALLS
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
} /* end of my_getenv() */
/*}}}*/
+static FILE *safe_popen(char *, char *);
+
/*{{{ void prime_env_iter() */
void
prime_env_iter(void)
(void) hv_fetch(envhv,"USER",4,TRUE);
/* Now, go get the logical names */
- if ((sholog = my_popen("$ Show Logical *","r")) == Nullfp)
+ if ((sholog = safe_popen("$ Show Logical *","r")) == Nullfp)
_ckvmssts(vaxc$errno);
- /* We use Perl's sv_gets to read from the pipe, since my_popen is
+ /* We use Perl's sv_gets to read from the pipe, since safe_popen is
* tied to Perl's I/O layer, so it may not return a simple FILE * */
oldrs = rs;
rs = newSVpv("\n",1);
{
char dirfile[NAM$C_MAXRSS+1];
int retval;
- struct stat st;
+ struct mystat st;
if (do_fileify_dirspec(name,dirfile,0) == NULL) return -1;
if (flex_stat(dirfile,&st) || !S_ISDIR(st.st_mode)) retval = -1;
} /* end of kill_file() */
/*}}}*/
+
+/*{{{int my_mkdir(char *,mode_t)*/
+int
+my_mkdir(char *dir, mode_t mode)
+{
+ STRLEN dirlen = strlen(dir);
+
+ /* CRTL mkdir() doesn't tolerate trailing /, since that implies
+ * null file name/type. However, it's commonplace under Unix,
+ * so we'll allow it for a gain in portability.
+ */
+ if (dir[dirlen-1] == '/') {
+ char *newdir = savepvn(dir,dirlen-1);
+ int ret = mkdir(newdir,mode);
+ Safefree(newdir);
+ return ret;
+ }
+ else return mkdir(dir,mode);
+} /* end of my_mkdir */
+/*}}}*/
+
+
static void
create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc)
{
static unsigned long int
pipe_exit_routine()
{
- unsigned long int retsts = SS$_NORMAL, abort = SS$_TIMEOUT, sts;
+ unsigned long int retsts = SS$_NORMAL, abort = SS$_TIMEOUT;
+ int sts;
while (open_pipes != NULL) {
if (!open_pipes->done) { /* Tap them gently on the shoulder . . .*/
}
if (!open_pipes->done) /* We tried to be nice . . . */
_ckvmssts(sys$delprc(&open_pipes->pid,0));
- if (!((sts = my_pclose(open_pipes->fp))&1)) retsts = sts;
+ if ((sts = my_pclose(open_pipes->fp)) == -1) retsts = vaxc$errno;
+ else if (!(sts & 1)) retsts = sts;
}
return retsts;
}
}
}
-/*{{{ FILE *my_popen(char *cmd, char *mode)*/
-FILE *
-my_popen(char *cmd, char *mode)
+static FILE *
+safe_popen(char *cmd, char *mode)
{
static int handler_set_up = FALSE;
char mbxname[64];
forkprocess = info->pid;
return info->fp;
+} /* end of safe_popen */
+
+
+/*{{{ FILE *my_popen(char *cmd, char *mode)*/
+FILE *
+my_popen(char *cmd, char *mode)
+{
+ TAINT_ENV();
+ TAINT_PROPER("popen");
+ return safe_popen(cmd,mode);
}
+
/*}}}*/
/*{{{ I32 my_pclose(FILE *fp)*/
for (info = open_pipes; info != NULL; last = info, info = info->next)
if (info->fp == fp) break;
- if (info == NULL)
- /* get here => no such pipe open */
- croak("No such pipe open");
+ if (info == NULL) { /* no such pipe open */
+ set_errno(ECHILD); /* quoth POSIX */
+ set_vaxc_errno(SS$_NONEXPR);
+ return -1;
+ }
/* If we were writing to a subprocess, insure that someone reading from
* the mailbox gets an EOF. It looks like a simple fclose() doesn't
/*
* VMS readdir() routines.
* Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
- * This code has no copyright.
*
* 21-Jul-1994 Charles Bailey bailey@genetics.upenn.edu
* Minor modifications to original routines.
{ /* no vfork - act VMSish */
unsigned long int retsts;
+ TAINT_ENV();
+ TAINT_PROPER("exec");
if ((retsts = setup_cmddsc(cmd,1)) & 1)
retsts = lib$do_command(&VMScmd);
{
unsigned long int substs, hadcmd = 1;
+ TAINT_ENV();
+ TAINT_PROPER("spawn");
if (!cmd || !*cmd) {
hadcmd = 0;
_ckvmssts(lib$spawn(0,0,0,0,0,0,&substs,0,0,0,0,0,0));
{
struct dsc$descriptor_s name_desc;
union uicdef uic;
- unsigned long int status, stat;
+ unsigned long int status, sts;
__pwdcache = __passwd_empty;
if (!fillpasswd(name, &__pwdcache)) {
name_desc.dsc$b_dtype= DSC$K_DTYPE_T;
name_desc.dsc$b_class= DSC$K_CLASS_S;
name_desc.dsc$a_pointer= (char *) name;
- if ((stat = sys$asctoid(&name_desc, &uic, 0)) == SS$_NORMAL) {
+ if ((sts = sys$asctoid(&name_desc, &uic, 0)) == SS$_NORMAL) {
__pwdcache.pw_uid= uic.uic$l_uic;
__pwdcache.pw_gid= uic.uic$v_group;
}
else {
- if (stat == SS$_NOSUCHID || stat == SS$_IVIDENT || stat == RMS$_PRV) {
- set_vaxc_errno(stat);
- set_errno(stat == RMS$_PRV ? EACCES : EINVAL);
+ if (sts == SS$_NOSUCHID || sts == SS$_IVIDENT || sts == RMS$_PRV) {
+ set_vaxc_errno(sts);
+ set_errno(sts == RMS$_PRV ? EACCES : EINVAL);
return NULL;
}
- else { _ckvmssts(stat); }
+ else { _ckvmssts(sts); }
}
}
strncpy(__pw_namecache, name, sizeof(__pw_namecache));
char *p;
time_t when;
+ if (timep == NULL) {
+ set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+ return NULL;
+ }
+ if (*timep == 0) gmtime_emulation_type = 0; /* possibly reset TZ */
if (gmtime_emulation_type == 0) (void) my_time(NULL); /* Init UTC */
when = *timep;
{
time_t when;
+ if (timep == NULL) {
+ set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+ return NULL;
+ }
+ if (*timep == 0) gmtime_emulation_type = 0; /* possibly reset TZ */
if (gmtime_emulation_type == 0) (void) my_time(NULL); /* Init UTC */
when = *timep;
* on the first call.
*/
#define LOCKID_MASK 0x80000000 /* Use 0 to force device name use only */
-static dev_t encode_dev (const char *dev)
+static mydev_t encode_dev (const char *dev)
{
int i;
unsigned long int f;
- dev_t enc;
+ mydev_t enc;
char c;
const char *q;
/* Do the permissions allow some operation? Assumes statcache already set. */
/* Do this via $Check_Access on VMS, since the CRTL stat() returns only a
- * subset of the applicable information.
+ * subset of the applicable information. (We have to stick with struct
+ * stat instead of struct mystat in the prototype since we have to match
+ * the one in proto.h.)
*/
/*{{{I32 cando(I32 bit, I32 effective, struct stat *statbufp)*/
I32
cando(I32 bit, I32 effective, struct stat *statbufp)
{
- if (statbufp == &statcache)
- return cando_by_name(bit,effective,namecache);
+ if (statbufp == &statcache) return cando_by_name(bit,effective,namecache);
else {
char fname[NAM$C_MAXRSS+1];
unsigned long int retsts;
/* If the struct mystat is stale, we're OOL; stat() overwrites the
device name on successive calls */
- devdsc.dsc$a_pointer = statbufp->st_devnam;
- devdsc.dsc$w_length = strlen(statbufp->st_devnam);
+ devdsc.dsc$a_pointer = ((struct mystat *)statbufp)->st_devnam;
+ devdsc.dsc$w_length = strlen(((struct mystat *)statbufp)->st_devnam);
namdsc.dsc$a_pointer = fname;
namdsc.dsc$w_length = sizeof fname - 1;
- retsts = lib$fid_to_name(&devdsc,&(statbufp->st_ino),&namdsc,
- &namdsc.dsc$w_length,0,0);
+ retsts = lib$fid_to_name(&devdsc,&(((struct mystat *)statbufp)->st_ino),
+ &namdsc,&namdsc.dsc$w_length,0,0);
if (retsts & 1) {
fname[namdsc.dsc$w_length] = '\0';
return cando_by_name(bit,effective,fname);
/*}}}*/
-/*{{{ int flex_fstat(int fd, struct stat *statbuf)*/
-#undef stat
+/*{{{ int flex_fstat(int fd, struct mystat *statbuf)*/
int
flex_fstat(int fd, struct mystat *statbufp)
{
if (!fstat(fd,(stat_t *) statbufp)) {
- if (statbufp == &statcache) *namecache == '\0';
+ if (statbufp == (struct mystat *) &statcache) *namecache == '\0';
statbufp->st_dev = encode_dev(statbufp->st_devnam);
# ifdef VMSISH_TIME
if (!VMSISH_TIME) { /* Return UTC instead of local time */
} /* end of flex_fstat() */
/*}}}*/
-/*{{{ int flex_stat(char *fspec, struct stat *statbufp)*/
-/* We defined 'stat' as 'mystat' in vmsish.h so that declarations of
- * 'struct stat' elsewhere in Perl would use our struct. We go back
- * to the system version here, since we're actually calling their
- * stat().
- */
+/*{{{ int flex_stat(char *fspec, struct mystat *statbufp)*/
int
flex_stat(char *fspec, struct mystat *statbufp)
{
char fileified[NAM$C_MAXRSS+1];
int retval = -1;
- if (statbufp == &statcache) do_tovmsspec(fspec,namecache,0);
+ if (statbufp == (struct mystat *) &statcache)
+ do_tovmsspec(fspec,namecache,0);
if (is_null_device(fspec)) { /* Fake a stat() for the null device */
memset(statbufp,0,sizeof *statbufp);
statbufp->st_dev = encode_dev("_NLA0:");
*/
if (do_fileify_dirspec(fspec,fileified,0) != NULL) {
retval = stat(fileified,(stat_t *) statbufp);
- if (!retval && statbufp == &statcache) strcpy(namecache,fileified);
+ if (!retval && statbufp == (struct mystat *) &statcache)
+ strcpy(namecache,fileified);
}
if (retval) retval = stat(fspec,(stat_t *) statbufp);
if (!retval) {
return retval;
} /* end of flex_stat() */
-/* Reset definition for later calls */
-#define stat mystat
/*}}}*/
/* Insures that no carriage-control translation will be done on a file. */
https://perl5.git.perl.org / perl5.git / blobdiff