void
_PXFOPEN(
#endif
_fcd PATH, /* Character variable containing argument */
_f_int *ILEN, /* Significant length of argument */
_f_int *IOPENFLAG, /* flag passed to open */
_f_int *IMODE, /* mode passed to open */
_f_int *IFILDES, /* file descriptor returned in this argument */
_f_int *IERROR /* Error status */
)
{
int arglen, errsts, length;
char *argstr, *pthstr;
errsts = 0;
argstr = _fcdtocp(PATH);
arglen = _fcdlen (PATH);
length = *ILEN;
*IFILDES = -1;
if (length < 0 || length > arglen)
errsts = EINVAL;
else {
/*
* If length is zero, user wants trailing blanks stripped.
* Otherwise, malloc memory and copy the string; adding a
* NULL terminator.
*/
if (length == 0)
pthstr = _fc_acopy(PATH);
else
pthstr = (char *) malloc(length + 1);
if (pthstr == NULL) /* If no memory allocated */
errsts = ENOMEM;
else {
if (length != 0) { /* Copy argument */
(void) memcpy(pthstr, argstr, length);
pthstr[length] = '\0';
}
/* Open the file */
if ((*IFILDES = open(pthstr, *IOPENFLAG, *IMODE)) == -1)
errsts = errno;
free(pthstr);
}
}
*IERROR = errsts;
return;
}
void
_PXFRMDIR(
#endif
_fcd PATH, /* Character variable containing argument */
_f_int *ILEN, /* Significant length of argument */
_f_int *IERROR /* Error status */
)
{
int arglen, errsts, length;
char *argstr, *pthstr;
errsts = 0;
argstr = _fcdtocp(PATH);
arglen = _fcdlen (PATH);
length = *ILEN;
if (length < 0 || length > arglen)
errsts = EINVAL;
else {
/*
* If length is zero, user wants trailing blanks stripped.
* Otherwise, malloc memory and copy the string; adding a
* NULL terminator.
*/
if (length == 0) {
pthstr = _fc_acopy(PATH);
} else {
pthstr = (char *) malloc(length + 1);
}
if (pthstr == NULL) /* If no memory allocated */
errsts = ENOMEM;
else {
if (length != 0) { /* Copy argument */
(void) memcpy(pthstr, argstr, length);
pthstr[length] = '\0';
}
/* Unlink the file */
if (rmdir(pthstr) == -1)
errsts = errno;
free(pthstr);
}
}
*IERROR = errsts;
return;
}
void
_PXFCREAT(
#endif
_fcd PATH, /* Character variable containing argument */
_f_int *ILEN, /* Significant length of character argument */
_f_int *IMODE, /* bitwise inclusive OR of file modes */
_f_int *IFILDES, /* integer containing file descriptor */
_f_int *IERROR /* Error status */
)
{
int arglen, errsts, length;
char *argstr, *pthstr;
errsts = 0;
argstr = _fcdtocp(PATH);
arglen = _fcdlen (PATH);
length = *ILEN;
*IFILDES = -1;
if (length < 0 || length > arglen)
errsts = EINVAL;
else {
/*
* If length is zero, user wants trailing blanks stripped.
* Otherwise, malloc memory and copy the string; adding a
* NULL terminator.
*/
if (length == 0)
pthstr = _fc_acopy(PATH);
else
pthstr = (char *) malloc(length + 1);
if (pthstr == NULL) /* If no memory allocated */
errsts = ENOMEM;
else {
if (length != 0) { /* Copy argument */
(void) memcpy(pthstr, argstr, length);
pthstr[length] = '\0';
}
/* Create or rewrite file with creat() */
if ((*IFILDES = creat(pthstr,*IMODE)) == -1)
errsts = errno;
free(pthstr);
}
}
*IERROR = errsts;
return;
}
void
_PXFCHMOD(
#endif
_fcd PATH, /* Character variable containing argument */
_f_int *ILEN, /* Significant length of character argument */
_f_int *IAMODE, /* bitwise inclusive OR of file modes */
_f_int *IERROR /* Error status */
)
{
_f_int arglen, errsts, length;
char *argstr, *pthstr;
int pmode;
errsts = 0;
argstr = _fcdtocp(PATH);
arglen = _fcdlen (PATH);
length = *ILEN;
pmode = *IAMODE;
if (length < 0 || length > arglen)
errsts = EINVAL;
else {
/*
* If length is zero, user wants trailing blanks stripped.
* Otherwise, malloc memory and copy the string; adding a
* NULL terminator.
*/
if (length == 0)
pthstr = _fc_acopy(PATH);
else
pthstr = (char *) malloc(length + 1);
if (pthstr == NULL) /* If no memory allocated */
errsts = ENOMEM;
else {
if (length != 0) { /* Copy argument */
(void) memcpy(pthstr, argstr, length);
pthstr[length] = '\0';
}
/* Change modes of the file through chmod() */
if (chmod(pthstr,pmode) == -1)
errsts = errno;
free(pthstr);
}
}
*IERROR = errsts;
return;
}
void
_PXFCHOWN(
#endif
_fcd PATH, /* name of file */
_f_int *ILEN, /* input length of PATH or zero */
_f_int *IOWNER, /* numeric value of new owner id */
_f_int *IGROUP, /* numeric value of new group id */
_f_int *IERROR /* Error status */
)
{
int arglen, errsts, length;
char *argstr, *pthstr;
errsts = 0;
argstr = _fcdtocp(PATH);
arglen = _fcdlen (PATH);
length = *ILEN;
if (length < 0 || length > arglen)
errsts = EINVAL;
else {
/*
* If length is zero, user wants trailing blanks stripped.
* Otherwise, malloc memory and copy the string; adding a
* NULL terminator.
*/
if (length == 0) {
pthstr = _fc_acopy(PATH);
} else {
pthstr = (char *) malloc(length + 1);
}
if (pthstr == NULL) /* If no memory allocated */
errsts = ENOMEM;
else {
if (length != 0) { /* Copy argument */
(void) memcpy(pthstr, argstr, length);
pthstr[length] = '\0';
}
/* Change owner and group of file with chown() */
if (chown(pthstr, *IOWNER, *IGROUP) == -1)
errsts = errno;
free(pthstr);
}
}
*IERROR = errsts;
return;
}
/*
* ASNQFILE - returns the assign attributes for a file name.
*
* Call from Fortran:
*
* CALL ASNQFILE(FNAME, ATTR, ISTAT)
*
* Parameters
*
* FNAME (I) file name
* ATTR (O) receives the assign options for this unit number
* ISTAT (O) 0 if any options were found, -1 if not found,
* >0 error code on error.
*/
void
#ifdef _UNICOS
ASNQFILE(
_fcd fname,
_fcd attrs,
_f_int *istat)
{
#else /* _SOLARIS, __mips, etc. */
asnqfile_(
char *fnamptr,
char *attrptr,
_f_int *istat,
int fnamlen,
int attrlen)
{
_fcd attrs = _cptofcd(attrptr, attrlen);
_fcd fname = _cptofcd(fnamptr, fnamlen);
#endif /* _SOLARIS */
int ret;
char *atstr;
char *cfname;
if ((cfname = _fc_acopy(fname)) == NULL) {
*istat = FENOMEMY;
}
ret = _get_a_options(0, cfname, (unum_t) 0, 0, NULL, &atstr,
_LELVL_RETURN);
free(cfname);
switch (ret) {
case -1: /* an error condition was encountered */
*istat = errno;
break;
case 0: /* attributes were not found */
*istat = NOT_FOUND;
break;
case 1: /* attributes were found */
*istat = FOUND;
if (_c2fcpy(atstr, attrs) == -1)
*istat = ERAS_ATTSPC;
free(atstr);
break;
}
if (*istat != FOUND)
(void)_c2fcpy("", attrs); /* fill with blanks */
return;
}
/*
* PXFMKFIFO -- Make a FIFO special File
* (section 5.4.2 of Posix 1003.9-1992)
*
* Synopsis:
*
* SUBROUTINE PXFMKFIFO(path, ilen, mode, ierror)
* INTEGER ilen, mode, ierror
* CHARACTER PATH*(*)
*
* Description:
*
* PXFMKFIFO uses the mkfifo() utility to create special first-in,
* first-out files.
*
* The arguments are:
*
* path - default character input variable containing the
* path name of the FIFO special file to be created.
* ilen - default input integer variable containing the
* length of path.
* mode - default input integer variable specifying the
* mode for the new file.
* ierror - default integer output variable that contains zero
* if the operation was successful or nonzero if the
* operation was not successful.
*
* PXFMKFIFO may return one of the following error values:
*
* EACCES If search permission is denied for a component of the
* path prefix or if write permission is denied to the
* parent directory.
*
* EEXIST If the specified file exists.
*
* EFAULT If path points outside the allocated process address
* space.
*
* EINVAL If the call contains an argument that is not valid or
* the special file would be on an NFS-mounted system.
*
* ENOENT If component of path does not exist or path is an
* empty string.
*
* ENOMEM If PXFREAD is unable to obtain memory to create an
* internal buffer.
*
* ENOTDIR If component of path is not a directory.
*
*
* ENXIO If the device associated with ifildes is a character
* special file that does not exist or the file pointer
* is out of range.
*
* On PVP systems, PXFMKFIFO may also return:
*
* EFLNEQ If active security label of calling process is outside
* range of the file system on which the file will reside.
*
* EIO If a physical I/O error has occurred, or the read is
* cannot access the device. or If ifildes has O_DIRECT
* or FDIRECT set and nbytes is greater than the number
* of bytes between the current file pointer position
* and the end of file.
*
* On IRIX systems, PXFMKFIFO may also return:
*
* EROFS If the parent directory for the new file is on a
* read-only system.
*
* ENAMETOOLONG If the length of path or a pathname component
* exceeds the maximum allowed.
*
* ENOSPC If the parent directory cannot be extended because
* the file system has no space available.
*
* EDQUOT If the parent directory cannot be extended because
* the disk or inode quota on the file system has been
* exhausted.
*
*/
#include <errno.h>
#include <fortran.h>
#include <liberrno.h>
#include <stdlib.h>
#include <string.h>
#include <sys/errno.h>
#include <sys/stat.h>
#include <sys/types.h>
#include <unistd.h>
extern char *_fc_acopy(_fcd f);
#ifdef _UNICOS
void
PXFMKFIFO(
#else /* _UNICOS */
void
_PXFMKFIFO(
#endif /* _UNICOS */
_fcd path,
_f_int *ilen,
_f_int *mode,
_f_int *ierror)
{
char *copy_path_adr;
char *path_adr;
int errsts = 0;
long copy_ilen;
long path_len;
mode_t copy_mode;
copy_ilen = *ilen;
*ierror = 0;
copy_mode = (mode_t)*mode;
path_len = _fcdlen(path);
path_adr = _fcdtocp(path);
if (copy_ilen < 0 || copy_ilen > path_len)
errsts = EINVAL;
else {
/* if ilen is zero, strip trailing blanks.
* Otherwise, malloc memory and copy the
* string and add a NULL terminator.
*/
if (copy_ilen == 0)
copy_path_adr = _fc_acopy(path);
else
copy_path_adr = (char *) malloc(copy_ilen + 1);
if (copy_path_adr == NULL)
errsts = ENOMEM;
else {
if (copy_ilen != 0) {
/* copy the path argument */
(void) memcpy(copy_path_adr, path_adr,
copy_ilen);
copy_path_adr[copy_ilen] = '\0';
}
if ((errsts = mkfifo(copy_path_adr, copy_mode)) == -1);
errsts = errno;
free(copy_path_adr);
}
}
*ierror = (_f_int)errsts;
return;
}
_f_int
ISHELL(_fcd cmdarg)
{
char *cptr;
int ret;
int fcdflag;
/* Check number of arguments */
if (_numargs() < 1)
return( (_f_int) -1);
/* IS cmdarg an _fcd ? */
fcdflag = 0;
#ifdef _ADDR64
if (_numargs() * sizeof(long) == sizeof(_fcd))
#else
if (_isfcd(cmdarg))
#endif
fcdflag = 1;
/* Convert argument to C character string */
if (fcdflag) { /* If Fortran character */
cptr = _fc_acopy(cmdarg);
if (cptr == NULL)
return( (_f_int) -1);
}
else
cptr = _fcdtocp(cmdarg);
/* Run command using system() */
ret = system(cptr);
if (ret == -1)
ret = -errno;
if (fcdflag)
free(cptr);
return( (_f_int) ret);
}
char *
_f2ccpy(_fcd f, ...)
{
va_list ap;
int slen;
char *sptr;
if (_numargs() * sizeof(long) == sizeof(_fcd))
return ( _fc_acopy(f) );
else {
/* get 2nd and 3rd arguments */
va_start(ap, f);
sptr = va_arg(ap, char *);
slen = va_arg(ap, int);
va_end(ap);
return ( _fc_copy(f, sptr, slen) );
}
}
void
_PXFGETPWNAM(
#endif
_fcd NAME,
_f_int *ILEN,
_f_int *JPASSWD,
_f_int *IERROR
)
{
int cilen;
char *cname;
struct passwd *passwdsrc, passwdtemp, *cjpasswd;
struct pxfhandle pxfhand;
cilen = *ILEN;
pxfhand = _pxfhandle_table_lookup(&_pxfhandle_table, *JPASSWD);
if (pxfhand.pxfstructptr == NULL || pxfhand.pxftype != PXF_PASSWD) {
*IERROR = EBADHANDLE;
return;
}
cjpasswd = pxfhand.pxfstructptr;
/* check for invalid range error on ILEN. */
if (cilen < 0 || cilen > _fcdlen(NAME)) {
*IERROR = EINVAL;
} else {
if (cilen == 0) {
/*
* If length is zero, user wants trailing blanks stripped.
* Otherwise, malloc memory and copy the string adding a
* NULL terminator.
*/
cname = _fc_acopy(NAME);
} else {
cname = (char *) malloc (cilen + 1);
if (cname != NULL) {
(void)memcpy(cname, _fcdtocp(NAME), cilen);
cname[cilen] ='\0';
} else {
*IERROR = ENOMEM;
return;
}
}
/* make call to getpwnam */
if ((passwdsrc = getpwnam(cname)) != NULL) {
free(cname);
/* copy the structures components since static storage is used */
/* component: pw_name (login name) */
passwdtemp.pw_name =
(char *) malloc((strlen(passwdsrc->pw_name)+1)*sizeof(char));
if (passwdtemp.pw_name == NULL) {
*IERROR = ENOMEM;
return;
}
(void)strcpy(passwdtemp.pw_name, passwdsrc->pw_name);
/* component: pw_uid (user ID) */
passwdtemp.pw_uid = passwdsrc->pw_uid;
/* component: pw_gid (group ID) */
passwdtemp.pw_gid = passwdsrc->pw_gid;
/* component: pw_dir (default login directory) */
passwdtemp.pw_dir =
(char *) malloc((strlen(passwdsrc->pw_dir)+1)*sizeof(char));
if (passwdtemp.pw_dir == NULL) {
*IERROR = ENOMEM;
free(passwdtemp.pw_name);
return;
}
(void)strcpy(passwdtemp.pw_dir, passwdsrc->pw_dir);
/* component: pw_shell (default login shell) */
passwdtemp.pw_shell =
(char *) malloc((strlen(passwdsrc->pw_shell)+1)*sizeof(char));
if (passwdtemp.pw_shell == NULL) {
*IERROR = ENOMEM;
free(passwdtemp.pw_name);
free(passwdtemp.pw_dir);
return;
}
(void)strcpy(passwdtemp.pw_shell, passwdsrc->pw_shell);
/* components not supported in Posix 1003.9-1992, but supported in target OSes */
/* component: pw_passwd (encrypted password) */
passwdtemp.pw_passwd =
(char *)malloc((strlen(passwdsrc->pw_passwd)+1)*sizeof(char));
if (passwdtemp.pw_passwd == NULL) {
*IERROR = ENOMEM;
free(passwdtemp.pw_name);
free(passwdtemp.pw_dir);
free(passwdtemp.pw_shell);
return;
}
(void)strcpy(passwdtemp.pw_passwd, passwdsrc->pw_passwd);
#ifndef _LITTLE_ENDIAN
/* component: pw_age (password age) */
passwdtemp.pw_age =
(char *)malloc((strlen(passwdsrc->pw_age)+1)*sizeof(char));
if (passwdtemp.pw_age == NULL) {
*IERROR = ENOMEM;
free(passwdtemp.pw_name);
free(passwdtemp.pw_dir);
free(passwdtemp.pw_shell);
free(passwdtemp.pw_passwd);
return;
}
(void)strcpy(passwdtemp.pw_age, passwdsrc->pw_age);
/* component: pw_comment (comment) */
passwdtemp.pw_comment =
(char *)malloc((strlen(passwdsrc->pw_comment)+1)*sizeof(char));
if (passwdtemp.pw_comment == NULL) {
*IERROR = ENOMEM;
free(passwdtemp.pw_name);
free(passwdtemp.pw_dir);
free(passwdtemp.pw_shell);
free(passwdtemp.pw_passwd);
free(passwdtemp.pw_age);
return;
}
(void)strcpy(passwdtemp.pw_comment, passwdsrc->pw_comment);
#endif /* not _LITTLE_ENDIAN */
/* component: pw_gecos */
passwdtemp.pw_gecos =
(char *)malloc((strlen(passwdsrc->pw_gecos)+1)*sizeof(char));
if (passwdtemp.pw_gecos == NULL) {
*IERROR = ENOMEM;
free(passwdtemp.pw_name);
free(passwdtemp.pw_dir);
free(passwdtemp.pw_shell);
free(passwdtemp.pw_passwd);
#ifndef _LITTLE_ENDIAN
free(passwdtemp.pw_age);
#endif /* not _LITTLE_ENDIAN */
free(passwdtemp.pw_gecos);
return;
}
(void)strcpy(passwdtemp.pw_gecos, passwdsrc->pw_gecos);
} else {
*IERROR = errno;
free(cname);
return;
}
}
/* free all components for the jpasswd handle. NOTE: free() as defined in ANSI C
* checks for a NULL pointer so this extra check does not need to be performed. */
free(cjpasswd->pw_name);
free(cjpasswd->pw_passwd);
#ifndef _LITTLE_ENDIAN
free(cjpasswd->pw_age);
free(cjpasswd->pw_comment);
#endif /* not _LITTLE_ENDIAN */
free(cjpasswd->pw_gecos);
free(cjpasswd->pw_dir);
free(cjpasswd->pw_shell);
*cjpasswd = passwdtemp;
}
void
_PXFOPENDIR(
#endif
_fcd DIRNAME,
_f_int *LENDIRNAME,
_f_int *IOPENDIRID,
_f_int *IERROR
)
{
int ilendirname;
char *cdirname;
DIR *dirptr;
_f_int copendirid;
ilendirname = *LENDIRNAME;
/* check DIRNAME length */
if (ilendirname < 0 || ilendirname > __fcdlen(DIRNAME)) {
*IERROR = EINVAL;
return;
}
if (*LENDIRNAME == 0) {
/*
* If length is zero, user wants trailing blanks stripped.
* Otherwise, malloc memory and copy the string adding a
* NULL terminator.
*/
cdirname = _fc_acopy(DIRNAME);
if (cdirname == NULL) {
*IERROR = ENOMEM;
return;
}
} else {
cdirname = (char *)malloc(ilendirname + 1);
if (cdirname != NULL) {
(void)strncpy(cdirname, _fcdtocp(DIRNAME), ilendirname);
cdirname[ilendirname] = '\0';
} else {
*IERROR = ENOMEM;
return;
}
}
if ((dirptr = opendir(cdirname)) == NULL) {
free(cdirname);
*IERROR = errno;
return;
}
/* assign the dirptr. NOTE: The user is now responsible to manage the
* the memory */
copendirid = _table_add(&_pxfdir_table, dirptr);
if (copendirid > 0) {
/* negate the id value so readdir can determine if the corresponding
* DIR structure has been used to read directory entries.
*/
*IOPENDIRID = -copendirid;
*IERROR = 0;
} else {
*IERROR = ENOMEM;
}
free(cdirname);
}
void
_PXFSETENV(
#endif
_fcd NAME,
_f_int *LENNAME,
_fcd NEW,
_f_int *LENNEW,
_f_int *IOTHERWISE,
_f_int *IERROR)
{
int ilenname, slenname, ilennew, slennew;
char *buf, *cname, *cnew;
ilenname = *LENNAME;
slenname = _fcdlen(NAME);
ilennew = *LENNEW;
slennew = _fcdlen(NEW);
*IERROR = 0;
/* check if the length of the lenname input argument is valid. */
if (ilenname < 0 || ilenname > slenname ||
ilennew < 0 || ilennew > slennew)
*IERROR = EINVAL;
else {
if (ilenname == 0) {
/*
* If length is zero, user wants trailing blanks stripped.
* Otherwise, malloc memory and copy the string adding a
* NULL terminator.
*/
cname = _fc_acopy(NAME);
ilenname = slenname;
} else {
cname = (char *) malloc (ilenname + 1);
if (cname != NULL) {
memcpy(cname, _fcdtocp(NAME), ilenname);
cname[ilenname] ='\0';
} else {
*IERROR = ENOMEM;
return;
}
}
/* check if NAME already exists in the envrion variable when
IOTHERWISE is zero. */
if (*IOTHERWISE == 0 && getenv(cname) != NULL)
return;
if (ilennew == 0) {
/*
* If length is zero, user wants trailing blanks stripped.
* Otherwise, malloc memory and copy the string adding a
* NULL terminator.
*/
cnew = _fc_acopy(NEW);
ilennew = slennew;
} else {
cnew = (char *) malloc(ilennew + 1);
if (cnew != NULL) {
memcpy(cnew, _fcdtocp(NEW), ilennew);
cnew[ilennew] ='\0';
} else {
*IERROR = ENOMEM;
return;
}
}
if (cname == NULL || cnew == NULL)
*IERROR = ENOMEM;
else {
/* concatenate strings to make cname=cnew pair */
if ((buf = (char *) malloc(ilenname + ilennew + 2)) == NULL) {
*IERROR = ENOMEM;
return;
} else {
/* create 'cname=cnew' pair */
strcpy(buf, cname);
strcat(buf, "=\0");
strcat(buf, cnew);
free(cname);
free(cnew);
}
if (putenv(buf) != 0)
*IERROR = ENOMEM;
}
}
return;
}
void
_PXFGETENV(
#endif
_fcd name,
_f_int *lenname,
_fcd value,
_f_int *lenval,
_f_int *ierror)
{
char *buf, *cp, *v;
int i, lensrc, lenin, lentarg, lenv;
lenin = *lenname;
lensrc = _fcdlen(name);
lentarg = _fcdlen(value);
*ierror = 0;
/* check if the length of the lenname input argument is valid. */
if (lenin < 0 || lenin > lensrc) {
*ierror = EINVAL;
*lenval = 0;
return;
}
if (lensrc != 0) {
/* Copy input name. If lenname = 0, the trailing blanks
* must be stripped and the string may be null when the
* trailing blanks are stripped.
*/
if ((buf = _fc_acopy(name)) == NULL) {
*ierror = ENOMEM;
*lenval = 0;
return;
}
/* check for all blank input string */
if (strlen(buf) == 0) {
*lenval = 0;
cp = _fcdtocp(value);
(void) memset (cp, (int) ' ', lentarg);
return;
}
/* get value of environment variable name */
#ifdef _UNICOS
if ((v = getenv (buf)) == NULL) {
#else
if ((v = _GETENV(buf)) == NULL) {
#endif
/* name not found, return without
* setting other values.
*/
*ierror = EINVAL;
*lenval = 0;
return;
}
free(buf);
lenv = strlen(v);
*lenval = lenv;
/*
* return ETRUNC when string length greater than size of VALUE
* but copy the string up to the size of VALUE
*/
if(lenv > lentarg)
*ierror = ETRUNC;
/* destination is a character variable */
cp = _fcdtocp(value);
for (i = 0; i < lentarg && *v != '\0'; i++){
*cp++=*v++;
}
} else {
/* zero-length FCD NAME, return null pointer */
*lenval = 0;
i=0;
cp = _fcdtocp(value);
}
/* blank fill if necessary */
for (;i<lentarg;i++){
*cp++=' ';
}
return;
}
#ifndef _UNICOS
void
pxfgetenv_(
char *NAME,
_f_int *LENNAME,
char *VALUE,
_f_int *LENVAL,
_f_int *IERROR,
_f_int namelen,
_f_int valuelen)
{
_PXFGETENV( _cptofcd(NAME, namelen), LENNAME,
_cptofcd(VALUE, valuelen), LENVAL, IERROR);
return;
}
void
_PXFEXECV(
#endif
_fcd PATH,
_f_int *LENPATH,
_fcd ARGV, /* packed array of fortran strings */
_f_int *LENARGV,
_f_int *IARGC,
_f_int *IERROR
)
{
char **arg, /* vector of argument strings for execv */
*cpath, /* file path for executable */
*cstring_ARGV; /* the C-style string for the ARGV fortran character
* descriptor */
int clenpath, /* equal to *LENPATH, the user defined length of PATH */
i, /* loop counter */
position, /* current position in the string cstring_ARGV */
ciargc, /* equal to *IARGC, the number of arguments for execv */
cstring_lenargv, /* the length of the FCD ARGV. Note: This is the length of
an individual FCD in the array ARGV. */
len; /* length of string to copy from cstring_ARGV to a string
in the arg vector of strings. */
clenpath = *LENPATH;
cstring_lenargv = _fcdlen(ARGV);
ciargc = *IARGC;
/* check for valid path length passed in by user */
if (clenpath < 0 || clenpath > _fcdlen(PATH)) {
*IERROR = EINVAL;
return;
} else {
if (clenpath == 0) {
/*
* If length is zero, user wants trailing blanks stripped.
* Otherwise, malloc memory and copy the string adding a
* NULL terminator.
*/
cpath = _fc_acopy(PATH);
} else {
cpath = (char *)malloc(clenpath + 1);
if (cpath != NULL) {
memcpy(cpath, _fcdtocp(PATH), clenpath);
cpath[clenpath] = '\0';
} else {
*IERROR = ENOMEM;
return;
}
}
}
/* attempt to copy all argument strings from ARGV */
/* check the LENARGV array for proper values before copying ARGV strings */
i = 0;
while (i < ciargc) {
len = LENARGV[i];
if (len < 0 || len > cstring_lenargv) {
*IERROR = EINVAL;
free(cpath);
return;
}
i++;
}
arg = (char **)calloc(ciargc + 1,sizeof(char *));
if (arg == NULL) {
*IERROR = ENOMEM;
free(cpath);
return;
}
cstring_ARGV = _fcdtocp(ARGV);
/* malloc the memory for all the strings copy each Fortran string
* into a C-style string */
for (i = 0, position = 0; i < ciargc; position += cstring_lenargv, i++) {
len = LENARGV[i];
/* strip off trailing blanks */
if (len == 0) {
len = cstring_lenargv - 1;
while ((len > 0) &&
cstring_ARGV[(i * cstring_lenargv) + len] == ' ') {
len--;
}
len++;
}
if ((arg[i] = (char *)malloc((len+1)*sizeof(char))) == NULL) {
for (; i >= 0; i--) {
free(arg[i]);
}
free(arg);
free(cpath);
*IERROR = ENOMEM;
return;
}
strncpy(arg[i], &cstring_ARGV[position], len);
arg[i][len] = '\0';
}
if (execv(cpath, arg) == -1) {
for (i--; i >= 0; i--) {
free(arg[i]);
}
free(arg);
free(cpath);
*IERROR = errno;
return;
}
*IERROR = 0;
}
