*
* VMS-specific routines for perl5
*
- * Last revised: 24-Apr-1999 by Charles Bailey bailey@newman.upenn.edu
- * Version: 5.5.58
+ * Last revised: 20-Aug-1999 by Charles Bailey bailey@newman.upenn.edu
+ * Version: 5.5.60
*/
#include <acedef.h>
# define prv$v_sysprv prv$r_prvdef_bits0.prv$v_sysprv
#endif
+#if defined(NEED_AN_H_ERRNO)
+dEXT int h_errno;
+#endif
struct itmlst_3 {
unsigned short int buflen;
unsigned short int *retlen;
};
+#define do_fileify_dirspec(a,b,c) mp_do_fileify_dirspec(aTHX_ a,b,c)
+#define do_pathify_dirspec(a,b,c) mp_do_pathify_dirspec(aTHX_ a,b,c)
+#define do_tovmsspec(a,b,c) mp_do_tovmsspec(aTHX_ a,b,c)
+#define do_tovmspath(a,b,c) mp_do_tovmspath(aTHX_ a,b,c)
+#define do_rmsexpand(a,b,c,d,e) mp_do_rmsexpand(aTHX_ a,b,c,d,e)
+#define do_tounixspec(a,b,c) mp_do_tounixspec(aTHX_ a,b,c)
+#define do_tounixpath(a,b,c) mp_do_tounixpath(aTHX_ a,b,c)
+#define expand_wild_cards(a,b,c,d) mp_expand_wild_cards(aTHX_ a,b,c,d)
+#define getredirection(a,b) mp_getredirection(aTHX_ a,b)
+
static char *__mystrtolower(char *str)
{
if (str) for (; *str; ++str) *str= tolower(*str);
static struct dsc$descriptor_s **env_tables = defenv;
static bool will_taint = FALSE; /* tainting active, but no PL_curinterp yet */
+/* True if we shouldn't treat barewords as logicals during directory */
+/* munching */
+static int no_translate_barewords;
+
+/* Temp for subprocess commands */
+static struct dsc$descriptor_s VMScmd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,Nullch};
+
/*{{{int vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, struct dsc$descriptor_s **tabvec, unsigned long int flags) */
int
-vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
+Perl_vmstrnenv(pTHX_ const char *lnm, char *eqv, unsigned long int idx,
struct dsc$descriptor_s **tabvec, unsigned long int flags)
{
- char uplnm[LNM$C_NAMLENGTH], *cp1, *cp2;
+ char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2;
unsigned short int eqvlen, curtab, ivlnm = 0, ivsym = 0, ivenv = 0, secure;
unsigned long int retsts, attr = LNM$M_CASE_BLIND;
unsigned char acmode;
}
lnmdsc.dsc$w_length = cp1 - lnm;
lnmdsc.dsc$a_pointer = uplnm;
+ uplnm[lnmdsc.dsc$w_length] = '\0';
secure = flags & PERL__TRNENV_SECURE;
acmode = secure ? PSL$C_EXEC : PSL$C_USER;
if (!tabvec || !*tabvec) tabvec = env_tables;
retsts = sys$trnlnm(&attr,tabvec[curtab],&lnmdsc,&acmode,lnmlst);
if (retsts == SS$_IVLOGNAM) { ivlnm = 1; continue; }
if (retsts == SS$_NOLOGNAM) continue;
+ /* PPFs have a prefix */
+ if (
+#if INTSIZE == 4
+ *((int *)uplnm) == *((int *)"SYS$") &&
+#endif
+ eqvlen >= 4 && eqv[0] == 0x1b && eqv[1] == 0x00 &&
+ ( (uplnm[4] == 'O' && !strcmp(uplnm,"SYS$OUTPUT")) ||
+ (uplnm[4] == 'I' && !strcmp(uplnm,"SYS$INPUT")) ||
+ (uplnm[4] == 'E' && !strcmp(uplnm,"SYS$ERROR")) ||
+ (uplnm[4] == 'C' && !strcmp(uplnm,"SYS$COMMAND")) ) ) {
+ memcpy(eqv,eqv+4,eqvlen-4);
+ eqvlen -= 4;
+ }
break;
}
}
/*{{{ int my_trnlnm(const char *lnm, char *eqv, unsigned long int idx)*/
/* Define as a function so we can access statics. */
-int my_trnlnm(const char *lnm, char *eqv, unsigned long int idx)
+int Perl_my_trnlnm(pTHX_ const char *lnm, char *eqv, unsigned long int idx)
{
return vmstrnenv(lnm,eqv,idx,fildev,
#ifdef SECURE_INTERNAL_GETENV
idx = strtoul(cp2+1,NULL,0);
lnm = uplnm;
}
+ /* Impose security constraints only if tainting */
+ if (sys) sys = PL_curinterp ? PL_tainting : will_taint;
if (vmstrnenv(lnm,eqv,idx,
sys ? fildev : NULL,
#ifdef SECURE_INTERNAL_GETENV
idx = strtoul(cp2+1,NULL,0);
lnm = buf;
}
+ /* Impose security constraints only if tainting */
+ if (sys) sys = PL_curinterp ? PL_tainting : will_taint;
if ((*len = vmstrnenv(lnm,buf,idx,
sys ? fildev : NULL,
#ifdef SECURE_INTERNAL_GETENV
$DESCRIPTOR(clidsc,"DCL"); $DESCRIPTOR(clitabdsc,"DCLTABLES");
$DESCRIPTOR(crtlenv,"CRTL_ENV"); $DESCRIPTOR(clisym,"CLISYM");
$DESCRIPTOR(local,"_LOCAL"); $DESCRIPTOR(mbxdsc,mbxnam);
-#ifdef USE_THREADS
+#if defined(USE_THREADS) || defined(USE_ITHREADS)
static perl_mutex primenv_mutex;
MUTEX_INIT(&primenv_mutex);
#endif
}
else {
if (!*eqv) eqvdsc.dsc$w_length = 1;
+ if (eqvdsc.dsc$w_length > LNM$C_NAMLENGTH) {
+ eqvdsc.dsc$w_length = LNM$C_NAMLENGTH;
+ if (ckWARN(WARN_MISC)) {
+ Perl_warner(aTHX_ WARN_MISC,"Value of logical \"%s\" too long. Truncating to %i bytes",lnm, LNM$C_NAMLENGTH);
+ }
+ }
retsts = lib$set_logical(&lnmdsc,&eqvdsc,tabvec[0],0,0);
}
}
usrdsc.dsc$a_pointer = usrname;
if (!((sts = sys$getuai(0, 0, &usrdsc, uailst, 0, 0, 0)) & 1)) {
switch (sts) {
- case SS$_NOGRPPRV:
- case SS$_NOSYSPRV:
+ case SS$_NOGRPPRV: case SS$_NOSYSPRV:
set_errno(EACCES);
break;
case RMS$_RNF:
/*}}}*/
-static char *do_rmsexpand(char *, char *, int, char *, unsigned);
-static char *do_fileify_dirspec(char *, char *, int);
-static char *do_tovmsspec(char *, char *, int);
+static char *mp_do_rmsexpand(pTHX_ char *, char *, int, char *, unsigned);
+static char *mp_do_fileify_dirspec(pTHX_ char *, char *, int);
+static char *mp_do_tovmsspec(pTHX_ char *, char *, int);
/*{{{int do_rmdir(char *name)*/
int
-do_rmdir(char *name)
+Perl_do_rmdir(pTHX_ char *name)
{
char dirfile[NAM$C_MAXRSS+1];
int retval;
newace.myace$l_ident = oldace.myace$l_ident;
if (!((aclsts = sys$change_acl(0,&type,&fildsc,lcklst,0,0,0)) & 1)) {
switch (aclsts) {
- case RMS$_FNF:
- case RMS$_DNF:
- case RMS$_DIR:
- case SS$_NOSUCHOBJECT:
+ case RMS$_FNF: case RMS$_DNF: case SS$_NOSUCHOBJECT:
set_errno(ENOENT); break;
+ case RMS$_DIR:
+ set_errno(ENOTDIR); break;
case RMS$_DEV:
set_errno(ENODEV); break;
- case RMS$_SYN:
- case SS$_INVFILFOROP:
+ case RMS$_SYN: case SS$_INVFILFOROP:
set_errno(EINVAL); break;
case RMS$_PRV:
set_errno(EACCES); break;
STRLEN dirlen = strlen(dir);
dTHX;
+ /* zero length string sometimes gives ACCVIO */
+ if (dirlen == 0) return -1;
+
/* 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.
} /* end of my_mkdir */
/*}}}*/
+/*{{{int my_chdir(char *)*/
+int
+my_chdir(char *dir)
+{
+ STRLEN dirlen = strlen(dir);
+ dTHX;
+
+ /* zero length string sometimes gives ACCVIO */
+ if (dirlen == 0) return -1;
+
+ /* some versions of CRTL chdir() 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 = chdir(newdir);
+ Safefree(newdir);
+ return ret;
+ }
+ else return chdir(dir);
+} /* end of my_chdir */
+/*}}}*/
static void
create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc)
info = open_pipes;
while (info) {
- if (info->mode != 'r' && !info->done) {
+ int need_eof;
+ _ckvmssts(sys$setast(0));
+ need_eof = info->mode != 'r' && !info->done;
+ _ckvmssts(sys$setast(1));
+ if (need_eof) {
if (pipe_eof(info->fp, 1) & 1) did_stuff = 1;
}
info = info->next;
did_stuff = 0;
info = open_pipes;
while (info) {
+ _ckvmssts(sys$setast(0));
if (!info->done) { /* Tap them gently on the shoulder . . .*/
sts = sys$forcex(&info->pid,0,&abort);
if (!(sts&1) && sts != SS$_NONEXPR) _ckvmssts(sts);
did_stuff = 1;
}
+ _ckvmssts(sys$setast(1));
info = info->next;
}
if (did_stuff) sleep(1); /* wait for them to respond */
info = open_pipes;
while (info) {
+ _ckvmssts(sys$setast(0));
if (!info->done) { /* We tried to be nice . . . */
sts = sys$delprc(&info->pid,0);
if (!(sts&1) && sts != SS$_NONEXPR) _ckvmssts(sts);
info->done = 1; /* so my_pclose doesn't try to write EOF */
}
+ _ckvmssts(sys$setast(1));
info = info->next;
}
}
}
+static unsigned long int setup_cmddsc(char *cmd, int check_img);
+static void vms_execfree(pTHX);
+
static PerlIO *
safe_popen(char *cmd, char *mode)
{
static int handler_set_up = FALSE;
char mbxname[64];
unsigned short int chan;
- unsigned long int flags=1; /* nowait - gnu c doesn't allow &1 */
+ unsigned long int sts, flags=1; /* nowait - gnu c doesn't allow &1 */
dTHX;
struct pipe_details *info;
struct dsc$descriptor_s namdsc = {sizeof mbxname, DSC$K_DTYPE_T,
DSC$K_CLASS_S, 0};
- cmddsc.dsc$w_length=strlen(cmd);
- cmddsc.dsc$a_pointer=cmd;
- if (cmddsc.dsc$w_length > 255) {
- set_errno(E2BIG); set_vaxc_errno(CLI$_BUFOVF);
- return Nullfp;
- }
-
+ if (!(setup_cmddsc(cmd,0) & 1)) { set_errno(EINVAL); return Nullfp; }
New(1301,info,1,struct pipe_details);
/* create mailbox */
info->completion=0;
if (*mode == 'r') {
- _ckvmssts(lib$spawn(&cmddsc, &nl_desc, &namdsc, &flags,
+ _ckvmssts(lib$spawn(&VMScmd, &nl_desc, &namdsc, &flags,
0 /* name */, &info->pid, &info->completion,
0, popen_completion_ast,info,0,0,0));
}
else {
- _ckvmssts(lib$spawn(&cmddsc, &namdsc, 0 /* sys$output */, &flags,
+ _ckvmssts(lib$spawn(&VMScmd, &namdsc, 0 /* sys$output */, &flags,
0 /* name */, &info->pid, &info->completion,
0, popen_completion_ast,info,0,0,0));
}
+ vms_execfree(aTHX);
if (!handler_set_up) {
_ckvmssts(sys$dclexh(&pipe_exitblock));
handler_set_up = TRUE;
{
struct pipe_details *info, *last = NULL;
unsigned long int retsts;
+ int need_eof;
for (info = open_pipes; info != NULL; last = info, info = info->next)
if (info->fp == fp) break;
/* 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
* produce an EOF record in the mailbox. */
- if (info->mode != 'r' && !info->done) pipe_eof(info->fp,0);
+ _ckvmssts(sys$setast(0));
+ need_eof = info->mode != 'r' && !info->done;
+ _ckvmssts(sys$setast(1));
+ if (need_eof) pipe_eof(info->fp,0);
PerlIO_close(info->fp);
if (info->done) retsts = info->completion;
else waitpid(info->pid,(int *) &retsts,0);
/* remove from list of open pipes */
+ _ckvmssts(sys$setast(0));
if (last) last->next = info->next;
else open_pipes = info->next;
+ _ckvmssts(sys$setast(1));
Safefree(info);
return retsts;
* rmesexpand() returns the address of the resultant string if
* successful, and NULL on error.
*/
-static char *do_tounixspec(char *, char *, int);
+static char *mp_do_tounixspec(pTHX_ char *, char *, int);
static char *
-do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts)
+mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsigned opts)
{
static char __rmsexpand_retbuf[NAM$C_MAXRSS+1];
char vmsfspec[NAM$C_MAXRSS+1], tmpfspec[NAM$C_MAXRSS+1];
retsts = sys$parse(&myfab,0,0);
if (!(retsts & 1)) {
mynam.nam$b_nop |= NAM$M_SYNCHK;
- if (retsts == RMS$_DNF || retsts == RMS$_DIR ||
- retsts == RMS$_DEV || retsts == RMS$_DEV) {
+ if (retsts == RMS$_DNF || retsts == RMS$_DIR || retsts == RMS$_DEV) {
retsts = sys$parse(&myfab,0,0);
if (retsts & 1) goto expanded;
}
}
/*}}}*/
/* External entry points */
-char *rmsexpand(char *spec, char *buf, char *def, unsigned opt)
+char *Perl_rmsexpand(pTHX_ char *spec, char *buf, char *def, unsigned opt)
{ return do_rmsexpand(spec,buf,0,def,opt); }
-char *rmsexpand_ts(char *spec, char *buf, char *def, unsigned opt)
+char *Perl_rmsexpand_ts(pTHX_ char *spec, char *buf, char *def, unsigned opt)
{ return do_rmsexpand(spec,buf,1,def,opt); }
*/
/*{{{ char *fileify_dirspec[_ts](char *path, char *buf)*/
-static char *do_fileify_dirspec(char *dir,char *buf,int ts)
+static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
{
static char __fileify_retbuf[NAM$C_MAXRSS+1];
unsigned long int dirlen, retlen, addmfd = 0, hasfilename = 0;
set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;
}
dirlen = strlen(dir);
- while (dir[dirlen-1] == '/') --dirlen;
+ while (dirlen && dir[dirlen-1] == '/') --dirlen;
if (!dirlen) { /* We had Unixish '/' -- substitute top of current tree */
strcpy(trndir,"/sys$disk/000000");
dir = trndir;
* ... do_fileify_dirspec("myroot",buf,1) ...
* does something useful.
*/
- if (!strcmp(dir+dirlen-2,".]")) {
+ if (dirlen >= 2 && !strcmp(dir+dirlen-2,".]")) {
dir[--dirlen] = '\0';
dir[dirlen-1] = ']';
}
(dir[2] == '\0' || (dir[2] == '/' && dir[3] == '\0')))
return do_fileify_dirspec("[-]",buf,ts);
}
- if (dir[dirlen-1] == '/') { /* path ends with '/'; just add .dir;1 */
+ if (dirlen && dir[dirlen-1] == '/') { /* path ends with '/'; just add .dir;1 */
dirlen -= 1; /* to last element */
lastdir = strrchr(dir,'/');
}
} while ((cp1 = strstr(cp1,"/.")) != NULL);
lastdir = strrchr(dir,'/');
}
- else if (!strcmp(&dir[dirlen-7],"/000000")) {
+ else if (dirlen >= 7 && !strcmp(&dir[dirlen-7],"/000000")) {
/* Ditto for specs that end in an MFD -- let the VMS code
* figure out whether it's a real device or a rooted logical. */
dir[dirlen] = '/'; dir[dirlen+1] = '\0';
/* Yes; fake the fnb bits so we'll check type below */
dirnam.nam$l_fnb |= NAM$M_EXP_TYPE | NAM$M_EXP_VER;
}
- else {
- if (dirfab.fab$l_sts != RMS$_FNF) {
- set_errno(EVMSERR);
- set_vaxc_errno(dirfab.fab$l_sts);
+ else { /* No; just work with potential name */
+ if (dirfab.fab$l_sts == RMS$_FNF) dirnam = savnam;
+ else {
+ set_errno(EVMSERR); set_vaxc_errno(dirfab.fab$l_sts);
+ dirnam.nam$b_nop |= NAM$M_SYNCHK; dirnam.nam$l_rlf = NULL;
+ dirfab.fab$b_dns = 0; (void) sys$parse(&dirfab,0,0);
return NULL;
}
- dirnam = savnam; /* No; just work with potential name */
}
}
if (!(dirnam.nam$l_fnb & (NAM$M_EXP_DEV | NAM$M_EXP_DIR))) {
cmplen = (dirnam.nam$l_fnb & NAM$M_EXP_VER) ? 6 : 4;
if (strncmp(dirnam.nam$l_type,".DIR;1",cmplen)) {
/* Something other than .DIR[;1]. Bzzt. */
+ dirnam.nam$b_nop |= NAM$M_SYNCHK; dirnam.nam$l_rlf = NULL;
+ dirfab.fab$b_dns = 0; (void) sys$parse(&dirfab,0,0);
set_errno(ENOTDIR);
set_vaxc_errno(RMS$_DIR);
return NULL;
else if (ts) New(1311,retspec,dirnam.nam$b_esl+1,char);
else retspec = __fileify_retbuf;
strcpy(retspec,esa);
+ dirnam.nam$b_nop |= NAM$M_SYNCHK; dirnam.nam$l_rlf = NULL;
+ dirfab.fab$b_dns = 0; (void) sys$parse(&dirfab,0,0);
return retspec;
}
if ((cp1 = strstr(esa,".][000000]")) != NULL) {
dirnam.nam$b_esl -= 9;
}
if ((cp1 = strrchr(esa,']')) == NULL) cp1 = strrchr(esa,'>');
- if (cp1 == NULL) return NULL; /* should never happen */
+ if (cp1 == NULL) { /* should never happen */
+ dirnam.nam$b_nop |= NAM$M_SYNCHK; dirnam.nam$l_rlf = NULL;
+ dirfab.fab$b_dns = 0; (void) sys$parse(&dirfab,0,0);
+ return NULL;
+ }
term = *cp1;
*cp1 = '\0';
retlen = strlen(esa);
/* Go back and expand rooted logical name */
dirnam.nam$b_nop = NAM$M_SYNCHK | NAM$M_NOCONCEAL;
if (!(sys$parse(&dirfab) & 1)) {
+ dirnam.nam$l_rlf = NULL;
+ dirfab.fab$b_dns = 0; (void) sys$parse(&dirfab,0,0);
set_errno(EVMSERR);
set_vaxc_errno(dirfab.fab$l_sts);
return NULL;
strcpy(cp2+9,cp1);
}
}
+ dirnam.nam$b_nop |= NAM$M_SYNCHK; dirnam.nam$l_rlf = NULL;
+ dirfab.fab$b_dns = 0; (void) sys$parse(&dirfab,0,0);
/* We've set up the string up through the filename. Add the
type and version, and we're done. */
strcat(retspec,".DIR;1");
} /* end of do_fileify_dirspec() */
/*}}}*/
/* External entry points */
-char *fileify_dirspec(char *dir, char *buf)
+char *Perl_fileify_dirspec(pTHX_ char *dir, char *buf)
{ return do_fileify_dirspec(dir,buf,0); }
-char *fileify_dirspec_ts(char *dir, char *buf)
+char *Perl_fileify_dirspec_ts(pTHX_ char *dir, char *buf)
{ return do_fileify_dirspec(dir,buf,1); }
/*{{{ char *pathify_dirspec[_ts](char *path, char *buf)*/
-static char *do_pathify_dirspec(char *dir,char *buf, int ts)
+static char *mp_do_pathify_dirspec(pTHX_ char *dir,char *buf, int ts)
{
static char __pathify_retbuf[NAM$C_MAXRSS+1];
unsigned long int retlen;
if (*dir) strcpy(trndir,dir);
else getcwd(trndir,sizeof trndir - 1);
- while (!strpbrk(trndir,"/]:>") && my_trnlnm(trndir,trndir,0)) {
+ while (!strpbrk(trndir,"/]:>") && !no_translate_barewords
+ && my_trnlnm(trndir,trndir,0)) {
STRLEN trnlen = strlen(trndir);
/* Trap simple rooted lnms, and return lnm:[000000] */
savnam = dirnam;
if (!(sys$search(&dirfab)&1)) { /* Does the file really exist? */
if (dirfab.fab$l_sts != RMS$_FNF) {
+ dirnam.nam$b_nop |= NAM$M_SYNCHK; dirnam.nam$l_rlf = NULL;
+ dirfab.fab$b_dns = 0; (void) sys$parse(&dirfab,0,0);
set_errno(EVMSERR);
set_vaxc_errno(dirfab.fab$l_sts);
return NULL;
cmplen = (dirnam.nam$l_fnb & NAM$M_EXP_VER) ? 6 : 4;
if (strncmp(dirnam.nam$l_type,".DIR;1",cmplen)) {
/* Something other than .DIR[;1]. Bzzt. */
+ dirnam.nam$b_nop |= NAM$M_SYNCHK; dirnam.nam$l_rlf = NULL;
+ dirfab.fab$b_dns = 0; (void) sys$parse(&dirfab,0,0);
set_errno(ENOTDIR);
set_vaxc_errno(RMS$_DIR);
return NULL;
else if (ts) New(1314,retpath,retlen,char);
else retpath = __pathify_retbuf;
strcpy(retpath,esa);
+ dirnam.nam$b_nop |= NAM$M_SYNCHK; dirnam.nam$l_rlf = NULL;
+ dirfab.fab$b_dns = 0; (void) sys$parse(&dirfab,0,0);
/* $PARSE may have upcased filespec, so convert output to lower
* case if input contained any lowercase characters. */
if (haslower) __mystrtolower(retpath);
} /* end of do_pathify_dirspec() */
/*}}}*/
/* External entry points */
-char *pathify_dirspec(char *dir, char *buf)
+char *Perl_pathify_dirspec(pTHX_ char *dir, char *buf)
{ return do_pathify_dirspec(dir,buf,0); }
-char *pathify_dirspec_ts(char *dir, char *buf)
+char *Perl_pathify_dirspec_ts(pTHX_ char *dir, char *buf)
{ return do_pathify_dirspec(dir,buf,1); }
/*{{{ char *tounixspec[_ts](char *path, char *buf)*/
-static char *do_tounixspec(char *spec, char *buf, int ts)
+static char *mp_do_tounixspec(pTHX_ char *spec, char *buf, int ts)
{
static char __tounixspec_retbuf[NAM$C_MAXRSS+1];
char *dirend, *rslt, *cp1, *cp2, *cp3, tmp[NAM$C_MAXRSS+1];
} /* end of do_tounixspec() */
/*}}}*/
/* External entry points */
-char *tounixspec(char *spec, char *buf) { return do_tounixspec(spec,buf,0); }
-char *tounixspec_ts(char *spec, char *buf) { return do_tounixspec(spec,buf,1); }
+char *Perl_tounixspec(pTHX_ char *spec, char *buf) { return do_tounixspec(spec,buf,0); }
+char *Perl_tounixspec_ts(pTHX_ char *spec, char *buf) { return do_tounixspec(spec,buf,1); }
/*{{{ char *tovmsspec[_ts](char *path, char *buf)*/
-static char *do_tovmsspec(char *path, char *buf, int ts) {
+static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) {
static char __tovmsspec_retbuf[NAM$C_MAXRSS+1];
char *rslt, *dirend;
register char *cp1, *cp2;
} /* end of do_tovmsspec() */
/*}}}*/
/* External entry points */
-char *tovmsspec(char *path, char *buf) { return do_tovmsspec(path,buf,0); }
-char *tovmsspec_ts(char *path, char *buf) { return do_tovmsspec(path,buf,1); }
+char *Perl_tovmsspec(pTHX_ char *path, char *buf) { return do_tovmsspec(path,buf,0); }
+char *Perl_tovmsspec_ts(pTHX_ char *path, char *buf) { return do_tovmsspec(path,buf,1); }
/*{{{ char *tovmspath[_ts](char *path, char *buf)*/
-static char *do_tovmspath(char *path, char *buf, int ts) {
+static char *mp_do_tovmspath(pTHX_ char *path, char *buf, int ts) {
static char __tovmspath_retbuf[NAM$C_MAXRSS+1];
int vmslen;
char pathified[NAM$C_MAXRSS+1], vmsified[NAM$C_MAXRSS+1], *cp;
} /* end of do_tovmspath() */
/*}}}*/
/* External entry points */
-char *tovmspath(char *path, char *buf) { return do_tovmspath(path,buf,0); }
-char *tovmspath_ts(char *path, char *buf) { return do_tovmspath(path,buf,1); }
+char *Perl_tovmspath(pTHX_ char *path, char *buf) { return do_tovmspath(path,buf,0); }
+char *Perl_tovmspath_ts(pTHX_ char *path, char *buf) { return do_tovmspath(path,buf,1); }
/*{{{ char *tounixpath[_ts](char *path, char *buf)*/
-static char *do_tounixpath(char *path, char *buf, int ts) {
+static char *mp_do_tounixpath(pTHX_ char *path, char *buf, int ts) {
static char __tounixpath_retbuf[NAM$C_MAXRSS+1];
int unixlen;
char pathified[NAM$C_MAXRSS+1], unixified[NAM$C_MAXRSS+1], *cp;
} /* end of do_tounixpath() */
/*}}}*/
/* External entry points */
-char *tounixpath(char *path, char *buf) { return do_tounixpath(path,buf,0); }
-char *tounixpath_ts(char *path, char *buf) { return do_tounixpath(path,buf,1); }
+char *Perl_tounixpath(pTHX_ char *path, char *buf) { return do_tounixpath(path,buf,0); }
+char *Perl_tounixpath_ts(pTHX_ char *path, char *buf) { return do_tounixpath(path,buf,1); }
/*
* @(#)argproc.c 2.2 94/08/16 Mark Pizzolato (mark@infocomm.com)
char *value,
int *count);
-static void expand_wild_cards(char *item,
- struct list_item **head,
- struct list_item **tail,
- int *count);
+static void mp_expand_wild_cards(pTHX_ char *item,
+ struct list_item **head,
+ struct list_item **tail,
+ int *count);
static int background_process(int argc, char **argv);
/*{{{ void getredirection(int *ac, char ***av)*/
static void
-getredirection(int *ac, char ***av)
+mp_getredirection(pTHX_ int *ac, char ***av)
/*
* Process vms redirection arg's. Exit if any error is seen.
* If getredirection() processes an argument, it is erased
exit(vaxc$errno);
}
if (err != NULL) {
+ if (strcmp(err,"&1") == 0) {
+ dup2(fileno(stdout), fileno(Perl_debug_log));
+ } else {
FILE *tmperr;
if (NULL == (tmperr = fopen(err, errmode, "mbc=32", "mbf=2")))
{
exit(vaxc$errno);
}
}
+ }
#ifdef ARGPROC_DEBUG
PerlIO_printf(Perl_debug_log, "Arglist:\n");
for (j = 0; j < *ac; ++j)
++(*count);
}
-static void expand_wild_cards(char *item,
+static void mp_expand_wild_cards(pTHX_ char *item,
struct list_item **head,
struct list_item **tail,
int *count)
set_vaxc_errno(sts);
switch (sts)
{
- case RMS$_FNF:
- case RMS$_DNF:
- case RMS$_DIR:
+ case RMS$_FNF: case RMS$_DNF:
set_errno(ENOENT); break;
+ case RMS$_DIR:
+ set_errno(ENOTDIR); break;
case RMS$_DEV:
set_errno(ENODEV); break;
- case RMS$_FNM:
- case RMS$_SYN:
+ case RMS$_FNM: case RMS$_SYN:
set_errno(EINVAL); break;
case RMS$_PRV:
set_errno(EACCES); break;
*/
/*{{{int trim_unixpath(char *fspec, char *wildspec, int opts)*/
int
-trim_unixpath(char *fspec, char *wildspec, int opts)
+Perl_trim_unixpath(pTHX_ char *fspec, char *wildspec, int opts)
{
char unixified[NAM$C_MAXRSS+1], unixwild[NAM$C_MAXRSS+1],
*template, *base, *end, *cp1, *cp2;
*/
/*{{{ DIR *opendir(char*name) */
DIR *
-opendir(char *name)
+Perl_opendir(pTHX_ char *name)
{
DIR *dd;
char dir[NAM$C_MAXRSS+1];
case RMS$_DEV:
set_errno(ENODEV); break;
case RMS$_DIR:
- case RMS$_FNF:
+ set_errno(ENOTDIR); break;
+ case RMS$_FNF: case RMS$_DNF:
set_errno(ENOENT); break;
default:
set_errno(EVMSERR);
/*}}}*/
-static struct dsc$descriptor_s VMScmd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,Nullch};
-
static void
-vms_execfree() {
+vms_execfree(pTHX) {
if (PL_Cmd) {
- Safefree(PL_Cmd);
+ if (PL_Cmd != VMScmd.dsc$a_pointer) Safefree(PL_Cmd);
PL_Cmd = Nullch;
}
if (VMScmd.dsc$a_pointer) {
static unsigned long int
setup_cmddsc(char *cmd, int check_img)
{
- char resspec[NAM$C_MAXRSS+1];
+ char vmsspec[NAM$C_MAXRSS+1], resspec[NAM$C_MAXRSS+1];
$DESCRIPTOR(defdsc,".EXE");
+ $DESCRIPTOR(defdsc2,".");
$DESCRIPTOR(resdsc,resspec);
struct dsc$descriptor_s imgdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
unsigned long int cxt = 0, flags = 1, retsts = SS$_NORMAL;
- register char *s, *rest, *cp;
- register int isdcl = 0;
+ register char *s, *rest, *cp, *wordbreak;
+ register int isdcl;
dTHX;
+ if (strlen(cmd) >
+ (sizeof(vmsspec) > sizeof(resspec) ? sizeof(resspec) : sizeof(vmsspec)))
+ return LIB$_INVARG;
s = cmd;
while (*s && isspace(*s)) s++;
- if (check_img) {
- if (*s == '$') { /* Check whether this is a DCL command: leading $ and */
- isdcl = 1; /* no dev/dir separators (i.e. not a foreign command) */
- for (cp = s; *cp && *cp != '/' && !isspace(*cp); cp++) {
- if (*cp == ':' || *cp == '[' || *cp == '<') {
- isdcl = 0;
- break;
- }
+
+ if (*s == '@' || *s == '$') {
+ vmsspec[0] = *s; rest = s + 1;
+ for (cp = &vmsspec[1]; *rest && isspace(*rest); rest++,cp++) *cp = *rest;
+ }
+ else { cp = vmsspec; rest = s; }
+ if (*rest == '.' || *rest == '/') {
+ char *cp2;
+ for (cp2 = resspec;
+ *rest && !isspace(*rest) && cp2 - resspec < sizeof resspec;
+ rest++, cp2++) *cp2 = *rest;
+ *cp2 = '\0';
+ if (do_tovmsspec(resspec,cp,0)) {
+ s = vmsspec;
+ if (*rest) {
+ for (cp2 = vmsspec + strlen(vmsspec);
+ *rest && cp2 - vmsspec < sizeof vmsspec;
+ rest++, cp2++) *cp2 = *rest;
+ *cp2 = '\0';
}
}
}
- else isdcl = 1;
+ /* Intuit whether verb (first word of cmd) is a DCL command:
+ * - if first nonspace char is '@', it's a DCL indirection
+ * otherwise
+ * - if verb contains a filespec separator, it's not a DCL command
+ * - if it doesn't, caller tells us whether to default to a DCL
+ * command, or to a local image unless told it's DCL (by leading '$')
+ */
+ if (*s == '@') isdcl = 1;
+ else {
+ register char *filespec = strpbrk(s,":<[.;");
+ rest = wordbreak = strpbrk(s," \"\t/");
+ if (!wordbreak) wordbreak = s + strlen(s);
+ if (*s == '$') check_img = 0;
+ if (filespec && (filespec < wordbreak)) isdcl = 0;
+ else isdcl = !check_img;
+ }
+
if (!isdcl) {
- cmd = s;
- while (*s && !isspace(*s)) s++;
- rest = *s ? s : 0;
- imgdsc.dsc$a_pointer = cmd;
- imgdsc.dsc$w_length = s - cmd;
+ imgdsc.dsc$a_pointer = s;
+ imgdsc.dsc$w_length = wordbreak - s;
retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,0,&flags);
- if (retsts & 1) {
+ if (!(retsts&1)) {
+ _ckvmssts(lib$find_file_end(&cxt));
+ retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc2,0,0,&flags);
+ if (!(retsts & 1) && *s == '$') {
+ _ckvmssts(lib$find_file_end(&cxt));
+ imgdsc.dsc$a_pointer++; imgdsc.dsc$w_length--;
+ retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,0,&flags);
+ if (!(retsts&1)) {
_ckvmssts(lib$find_file_end(&cxt));
+ retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc2,0,0,&flags);
+ }
+ }
+ }
+ _ckvmssts(lib$find_file_end(&cxt));
+
+ if (retsts & 1) {
+ FILE *fp;
s = resspec;
while (*s && !isspace(*s)) s++;
*s = '\0';
+
+ /* check that it's really not DCL with no file extension */
+ fp = fopen(resspec,"r","ctx=bin,shr=get");
+ if (fp) {
+ char b[4] = {0,0,0,0};
+ read(fileno(fp),b,4);
+ isdcl = isprint(b[0]) && isprint(b[1]) && isprint(b[2]) && isprint(b[3]);
+ fclose(fp);
+ }
+ if (check_img && isdcl) return RMS$_FNF;
+
if (cando_by_name(S_IXUSR,0,resspec)) {
New(402,VMScmd.dsc$a_pointer,7 + s - resspec + (rest ? strlen(rest) : 0),char);
+ if (!isdcl) {
strcpy(VMScmd.dsc$a_pointer,"$ MCR ");
+ } else {
+ strcpy(VMScmd.dsc$a_pointer,"@");
+ }
strcat(VMScmd.dsc$a_pointer,resspec);
if (rest) strcat(VMScmd.dsc$a_pointer,rest);
VMScmd.dsc$w_length = strlen(VMScmd.dsc$a_pointer);
}
/* It's either a DCL command or we couldn't find a suitable image */
VMScmd.dsc$w_length = strlen(cmd);
- if (cmd == PL_Cmd) {
- VMScmd.dsc$a_pointer = PL_Cmd;
- PL_Cmd = Nullch; /* Don't try to free twice in vms_execfree() */
- }
+ if (cmd == PL_Cmd) VMScmd.dsc$a_pointer = PL_Cmd;
else VMScmd.dsc$a_pointer = savepvn(cmd,VMScmd.dsc$w_length);
if (!(retsts & 1)) {
/* just hand off status values likely to be due to user error */
retsts = lib$do_command(&VMScmd);
switch (retsts) {
- case RMS$_FNF:
+ case RMS$_FNF: case RMS$_DNF:
set_errno(ENOENT); break;
- case RMS$_DNF: case RMS$_DIR: case RMS$_DEV:
+ case RMS$_DIR:
set_errno(ENOTDIR); break;
+ case RMS$_DEV:
+ set_errno(ENODEV); break;
case RMS$_PRV:
set_errno(EACCES); break;
case RMS$_SYN:
Perl_warner(aTHX_ WARN_EXEC,"Can't exec \"%*s\": %s",
VMScmd.dsc$w_length, VMScmd.dsc$a_pointer, Strerror(errno));
}
- vms_execfree();
+ vms_execfree(aTHX);
}
return FALSE;
if (!(sts & 1)) {
switch (sts) {
- case RMS$_FNF:
+ case RMS$_FNF: case RMS$_DNF:
set_errno(ENOENT); break;
- case RMS$_DNF: case RMS$_DIR: case RMS$_DEV:
+ case RMS$_DIR:
set_errno(ENOTDIR); break;
+ case RMS$_DEV:
+ set_errno(ENODEV); break;
case RMS$_PRV:
set_errno(EACCES); break;
case RMS$_SYN:
Strerror(errno));
}
}
- vms_execfree();
+ vms_execfree(aTHX);
return substs;
} /* end of do_spawn() */
my_flush(FILE *fp)
{
int res;
- if ((res = fflush(fp)) == 0) {
+ if ((res = fflush(fp)) == 0 && fp) {
#ifdef VMS_DO_SOCKETS
Stat_t s;
if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode))
# define RTL_USES_UTC 1
#endif
+/*
+ * DEC C previous to 6.0 corrupts the behavior of the /prefix
+ * qualifier with the extern prefix pragma. This provisional
+ * hack circumvents this prefix pragma problem in previous
+ * precompilers.
+ */
+#if defined(__VMS_VER) && __VMS_VER >= 70000000
+# if defined(VMS_WE_ARE_CASE_SENSITIVE) && (__DECC_VER < 60000000)
+# pragma __extern_prefix save
+# pragma __extern_prefix "" /* set to empty to prevent prefixing */
+# define gmtime decc$__utctz_gmtime
+# define localtime decc$__utctz_localtime
+# define time decc$__utc_time
+# pragma __extern_prefix restore
+
+ struct tm *gmtime(), *localtime();
+
+# endif
+#endif
+
+
static time_t toutc_dst(time_t loc) {
struct tm *rsltmp;
if (rsltmp->tm_isdst) loc -= 3600;
return loc;
}
-#define _toutc(secs) ((secs) == -1 ? -1 : \
+#define _toutc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \
((gmtime_emulation_type || my_time(NULL)), \
(gmtime_emulation_type == 1 ? toutc_dst(secs) : \
((secs) - utc_offset_secs))))
if (rsltmp->tm_isdst) utc += 3600;
return utc;
}
-#define _toloc(secs) ((secs) == -1 ? -1 : \
+#define _toloc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \
((gmtime_emulation_type || my_time(NULL)), \
(gmtime_emulation_type == 1 ? toloc_dst(secs) : \
((secs) + utc_offset_secs))))
/* If input was UTC; convert to local for sys svc */
if (!VMSISH_TIME) unixtime = _toloc(unixtime);
# endif
- unixtime >> 1; secscale << 1;
+ unixtime >>= 1; secscale <<= 1;
retsts = lib$emul(&secscale, &unixtime, &lowbit, bintime);
if (!(retsts & 1)) {
set_errno(EVMSERR);
}
retsts = sys$search(&myfab,0,0);
if (!(retsts & 1)) {
+ mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL;
+ myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0);
set_vaxc_errno(retsts);
if (retsts == RMS$_PRV) set_errno(EACCES);
else if (retsts == RMS$_FNF) set_errno(ENOENT);
retsts = sys$assign(&devdsc,&chan,0,0);
if (!(retsts & 1)) {
+ mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL;
+ myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0);
set_vaxc_errno(retsts);
if (retsts == SS$_IVDEVNAM) set_errno(ENOTDIR);
else if (retsts == SS$_NOPRIV) set_errno(EACCES);
myfib.fib$r_acctl_overlay.fib$l_acctl = FIB$M_NORECORD;
#endif
retsts = sys$qiow(0,chan,IO$_MODIFY,iosb,0,0,&fibdsc,&fnmdsc,0,0,myatr,0);
+ mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL;
+ myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0);
_ckvmssts(sys$dassgn(chan));
if (retsts & 1) retsts = iosb[0];
if (!(retsts & 1)) {
/* Do this via $Check_Access on VMS, since the CRTL stat() returns only a
* subset of the applicable information.
*/
-/*{{{I32 cando(I32 bit, I32 effective, struct stat *statbufp)*/
-I32
-Perl_cando(pTHX_ I32 bit, I32 effective, Stat_t *statbufp)
+bool
+Perl_cando(pTHX_ Mode_t bit, Uid_t effective, Stat_t *statbufp)
{
if (statbufp == &PL_statcache) return cando_by_name(bit,effective,namecache);
else {
/*}}}*/
-/*{{{I32 cando_by_name(I32 bit, I32 effective, char *fname)*/
+/*{{{I32 cando_by_name(I32 bit, Uid_t effective, char *fname)*/
I32
-cando_by_name(I32 bit, I32 effective, char *fname)
+cando_by_name(I32 bit, Uid_t effective, char *fname)
{
static char usrname[L_cuserid];
static struct dsc$descriptor_s usrdsc =
}
switch (bit) {
- case S_IXUSR:
- case S_IXGRP:
- case S_IXOTH:
- access = ARM$M_EXECUTE;
- break;
- case S_IRUSR:
- case S_IRGRP:
- case S_IROTH:
- access = ARM$M_READ;
- break;
- case S_IWUSR:
- case S_IWGRP:
- case S_IWOTH:
- access = ARM$M_WRITE;
- break;
- case S_IDUSR:
- case S_IDGRP:
- case S_IDOTH:
- access = ARM$M_DELETE;
- break;
+ case S_IXUSR: case S_IXGRP: case S_IXOTH:
+ access = ARM$M_EXECUTE; break;
+ case S_IRUSR: case S_IRGRP: case S_IROTH:
+ access = ARM$M_READ; break;
+ case S_IWUSR: case S_IWGRP: case S_IWOTH:
+ access = ARM$M_WRITE; break;
+ case S_IDUSR: case S_IDGRP: case S_IDOTH:
+ access = ARM$M_DELETE; break;
default:
return FALSE;
}
if (retsts == SS$_ACCONFLICT) {
return TRUE;
}
+
+#if defined(__ALPHA) && defined(__VMS_VER) && __VMS_VER == 70100022 && defined(__DECC_VER) && __DECC_VER == 6009001
+ /* XXX Hideous kluge to accomodate error in specific version of RTL;
+ we hope it'll be buried soon */
+ if (retsts == 114762) return TRUE;
+#endif
_ckvmssts(retsts);
return FALSE; /* Should never get here */
*/
/*{{{int rmscopy(char *src, char *dst, int preserve_dates)*/
int
-rmscopy(char *spec_in, char *spec_out, int preserve_dates)
+Perl_rmscopy(pTHX_ char *spec_in, char *spec_out, int preserve_dates)
{
char vmsin[NAM$C_MAXRSS+1], vmsout[NAM$C_MAXRSS+1], esa[NAM$C_MAXRSS],
rsa[NAM$C_MAXRSS], ubf[32256];
if (!((sts = sys$open(&fab_in)) & 1)) {
set_vaxc_errno(sts);
switch (sts) {
- case RMS$_FNF:
- case RMS$_DIR:
+ case RMS$_FNF: case RMS$_DNF:
set_errno(ENOENT); break;
+ case RMS$_DIR:
+ set_errno(ENOTDIR); break;
case RMS$_DEV:
set_errno(ENODEV); break;
case RMS$_SYN:
if (!((sts = sys$create(&fab_out)) & 1)) {
set_vaxc_errno(sts);
switch (sts) {
- case RMS$_DIR:
+ case RMS$_DNF:
set_errno(ENOENT); break;
+ case RMS$_DIR:
+ set_errno(ENOTDIR); break;
case RMS$_DEV:
set_errno(ENODEV); break;
case RMS$_SYN:
XSRETURN(1);
}
+
+void
+mod2fname(CV *cv)
+{
+ dXSARGS;
+ char ultimate_name[NAM$C_MAXRSS+1], work_name[NAM$C_MAXRSS*8 + 1],
+ workbuff[NAM$C_MAXRSS*1 + 1];
+ int total_namelen = 3, counter, num_entries;
+ /* ODS-5 ups this, but we want to be consistent, so... */
+ int max_name_len = 39;
+ AV *in_array = (AV *)SvRV(ST(0));
+
+ num_entries = av_len(in_array);
+
+ /* All the names start with PL_. */
+ strcpy(ultimate_name, "PL_");
+
+ /* Clean up our working buffer */
+ Zero(work_name, sizeof(work_name), char);
+
+ /* Run through the entries and build up a working name */
+ for(counter = 0; counter <= num_entries; counter++) {
+ /* If it's not the first name then tack on a __ */
+ if (counter) {
+ strcat(work_name, "__");
+ }
+ strcat(work_name, SvPV(*av_fetch(in_array, counter, FALSE),
+ PL_na));
+ }
+
+ /* Check to see if we actually have to bother...*/
+ if (strlen(work_name) + 3 <= max_name_len) {
+ strcat(ultimate_name, work_name);
+ } else {
+ /* It's too darned big, so we need to go strip. We use the same */
+ /* algorithm as xsubpp does. First, strip out doubled __ */
+ char *source, *dest, last;
+ dest = workbuff;
+ last = 0;
+ for (source = work_name; *source; source++) {
+ if (last == *source && last == '_') {
+ continue;
+ }
+ *dest++ = *source;
+ last = *source;
+ }
+ /* Go put it back */
+ strcpy(work_name, workbuff);
+ /* Is it still too big? */
+ if (strlen(work_name) + 3 > max_name_len) {
+ /* Strip duplicate letters */
+ last = 0;
+ dest = workbuff;
+ for (source = work_name; *source; source++) {
+ if (last == toupper(*source)) {
+ continue;
+ }
+ *dest++ = *source;
+ last = toupper(*source);
+ }
+ strcpy(work_name, workbuff);
+ }
+
+ /* Is it *still* too big? */
+ if (strlen(work_name) + 3 > max_name_len) {
+ /* Too bad, we truncate */
+ work_name[max_name_len - 2] = 0;
+ }
+ strcat(ultimate_name, work_name);
+ }
+
+ /* Okay, return it */
+ ST(0) = sv_2mortal(newSVpv(ultimate_name, 0));
+ XSRETURN(1);
+}
+
void
init_os_extras()
{
char* file = __FILE__;
+ dTHX;
+ char temp_buff[512];
+ if (my_trnlnm("DECC$DISABLE_TO_VMS_LOGNAME_TRANSLATION", temp_buff, 0)) {
+ no_translate_barewords = TRUE;
+ } else {
+ no_translate_barewords = FALSE;
+ }
newXSproto("VMS::Filespec::rmsexpand",rmsexpand_fromperl,file,"$;$");
newXSproto("VMS::Filespec::vmsify",vmsify_fromperl,file,"$");
newXSproto("VMS::Filespec::vmspath",vmspath_fromperl,file,"$");
newXSproto("VMS::Filespec::unixpath",unixpath_fromperl,file,"$");
newXSproto("VMS::Filespec::candelete",candelete_fromperl,file,"$");
+ newXSproto("DynaLoader::mod2fname", mod2fname, file, "$");
newXS("File::Copy::rmscopy",rmscopy_fromperl,file);
return;
projects / p5sagit/p5-mst-13.2.git / blobdiff