v07i069: Unix-like tools for VMS systems, Part01/02

sources-request at mirror.UUCP sources-request at mirror.UUCP
Thu Dec 4 05:25:13 AEST 1986


Submitted by: David Albrecht <calmasd!dca at edison.GE.COM>
Mod.sources: Volume 7, Issue 69
Archive-name: vms_tools/Part01

[  Not having access to VMS, I haven't tried these.  --r$  ]

#!/bin/sh
#
# The following files are VMS C programs which will
# interface with VMS to provide some unix-like capabilities.
# One file, (unixlike) gives a simplistic introduction to the
# tools in 'roff format.
# 
# Most of the files are well documented in comments at the
# beginning as to their function and are totally stand alone.
# 
# The file cd.com is a DCL script for the CD command under
# VMS for those people who don't possess the C compiler.
# 
# The file reset is a one line symbol definition which should
# be added to a symbol definition file (ala. login.com) to add
# a command (RESET) which will reset the JOB tracking system when
# it goes astray.
# 
# David Albrecht
# 
#
echo 'Start of vms, part 02 of 02:'
echo 'x - cd.c'
sed 's/^X//' > cd.c << '/'
X#define NULL 0
X#define MAXSTRING 132
X
X#include <ctype.h>
X#include <rms.h>
X#include <stdio.h>
X#include <stsdef.h>
X#include <ssdef.h>
X#include <descrip.h>
X
Xstruct dsc$descriptor_s desc,desc1;
X
Xmain (argc,argv)
X    int argc;
X    char **argv;
X
X{   char curdir[MAXSTRING],testdir[MAXSTRING],todir[MAXSTRING];
X    char *p1,*dirspec,*strpos();
X    int i;
X
X    if (argc <= 1) {
X	getlogical("SYS$LOGIN",todir);
X	if (chdir(todir,1)) {
X	    invalid_dirspec(todir);
X	    return(1);
X	}
X    }
X    else {
X	p1 = argv[1];
X	if (strchr(p1,'[')
X	 || strpos(p1,"..")
X	 || strchr(p1,'/')) {
X	    if (chdir(p1,1)) {
X		invalid_dirspec(p1);
X		return(1);
X	    }
X	}
X	else if (getlogical(p1,todir)) {
X	    if (chdir(p1,1)) {
X		invalid_dirspec(p1);
X		return(1);
X	    }
X	}
X	else {
X	    dirspec = strrchr(p1,':');
X	    if (!dirspec) {
X		*todir = '\0';
X		dirspec = p1;
X	    }
X	    else {
X		i = dirspec-p1+1;
X		strncpy(todir,p1,i);
X		todir[i]='\0';
X		dirspec++;
X	    }
X	    strcat(todir,"[");
X	    if (*dirspec != '.'
X	     && *dirspec != '-'
X	     && dirspec == p1) strcat(todir,".");
X	    strcat(todir,dirspec);
X	    strcat(todir,"]");
X	    if (chdir(todir,1)) {
X		invalid_dirspec(todir);
X		return(1);
X	    }
X	}
X    }
X}
Xgetlogical(logical_name,value)
Xchar *logical_name,*value;
X{   int valuelen;
X    char cap_name[MAXSTRING],*cap_indx,*logical_indx;
X
X    logical_indx = logical_name;
X    cap_indx = cap_name;
X    while (*cap_indx++ = toupper(*logical_indx++));
X    setdesc(&desc,cap_name,strlen(cap_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    lib$sys_trnlog(&desc,&valuelen,&desc1,0,0,0);
X    value[valuelen] = '\0';
X    if (!strcmp(cap_name,value)) {
X	return(0);
X    }
X    return(1);
X
X}
Xgetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int valuelen,status;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    status = lib$get_symbol(&desc,&desc1,&valuelen,0);
X    if (status & STS$M_SUCCESS) {
X	value[valuelen] = '\0';
X	return(1);
X    }
X    else {
X	return(0);
X    }
X}
Xgetwd(pwd)
Xchar *pwd;
X{   int pwdlen;
X
X    setdesc(&desc,pwd,MAXSTRING-1);
X    pwdlen = 0;
X    sys$setddir(0,&pwdlen,&desc);
X    pwd[pwdlen] = '\0';
X}
Xinvalid_dirspec(dirspec)
Xchar *dirspec;
X{
X    fprintf(stderr,"invalid directory %s\n",dirspec);
X}
Xsetdesc(descr,str,strlen)
Xstruct dsc$descriptor_s *descr;
Xchar *str;
Xint strlen;
X{
X    descr->dsc$w_length = strlen;
X    descr->dsc$a_pointer = str;
X    descr->dsc$b_class = DSC$K_CLASS_S;	/* String desc class */
X    descr->dsc$b_dtype = DSC$K_DTYPE_T;	/* Ascii string type */
X}
Xsetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int valuelen;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    setdesc(&desc1,value,strlen(value));
X    lib$set_symbol(&desc,&desc1,0);
X}
X
Xchar *strpos(str,searchstr)
Xchar *str,*searchstr;
X{   char *matchc,c,*matchstr;
X
X    matchc = searchstr;
X    c = *matchc++;
X    while (c) {
X	if (!*str) {
X	    return(NULL);
X	}
X	else {
X	    matchstr = str++;
X	    while (c == *matchstr && *matchstr++) {
X		c = *matchc++;
X	    }
X	    if (!c) {
X	 	return(str - 1);
X	    }
X	    matchc = searchstr;
X	    c = *matchc++;
X	}
X    }
X    return(NULL);
X}
/
echo 'x - cd.com'
sed 's/^X//' > cd.com << '/'
X$	if p1 .eqs. "\"   then  p1 := 'cd_last_dir'
X$	if p1 .eqs. ""    then	p1 := 'f$logical("SYS$LOGIN")'
X$	len = 'f$length(p1)' 
X$	if p1 .eqs. "[-]" then goto updir
X$	if 'f$locate("[",p1)' .nes. len then goto setdef
X$	if "''f$logical(p1)'" .nes. "" then  goto chdir
X$	if p1 .nes. ".."  then goto chkroot
X$ updir:
X$	curdir := 'f$directory()'
X$	if curdir .eqs. "[000000]" then goto nodir
X$	p1 := "[-]"
X$	goto chdir
X$ chkroot:
X$	if p1 .nes. "000000" then goto chksub
X$	p1 := "[000000]"
X$	goto chdir
X$ chksub:
X$	if 'f$locate(".",p1)' .eqs. len then p1 := .'p1'
X$	p1 := "[''p1']"
X$ setdef:
X$	len = 'f$length(p1)'
X$	end = 'f$locate("]",p1)'
X$	beg = end - 1
X$ findbeg:
X$	c := "''f$extract(beg,1,p1)'"
X$	if c .eqs. "[" then goto dirbeg1
X$	if c .eqs. "." then goto dirbeg2
X$	beg = beg - 1
X$	goto findbeg
X$ dirbeg1:
X$	opendir := 'f$extract(0, beg + 1, p1)'"000000"
X$	goto testdir
X$ dirbeg2:
X$	opendir := "''f$extract(0, beg, p1)'"
X$ testdir:
X$	opendir := 'opendir''f$extract(end, len - end, p1)''f$extract(beg + 1, end - beg - 1, p1)'".dir"
X$	open/error=nodir dir 'opendir'
X$	close dir
X$ chdir:
X$	cd_last_dir :== 'f$logical("SYS$DISK")''f$directory()'
X$	set default 'p1'
X$	set prompt='f$directory()'>
X$	if p2 .nes. "" then cd "''p2'" "''p3'" "''p4'"
X$	exit
X$ nodir:
X$	write sys$error "invalid directory"
X$	exit
/
echo 'x - cdhash.c'
sed 's/^X//' > cdhash.c << '/'
X#define NULL 0
X#define MAXSTRING 132
X
X#include <ctype.h>
X#include <rms.h>
X#include <stdio.h>
X#include <stsdef.h>
X#include <ssdef.h>
X#include <descrip.h>
X
Xstruct dsc$descriptor_s desc,desc1;
X
Xmain (argc,argv)
X    int argc;
X    char **argv;
X
X{   char target[MAXSTRING],todir[MAXSTRING],dirlist[MAXSTRING];
X    char dirname[MAXSTRING],*startname,*endname;
X    int i,context;
X
X    if (!getsymbol("CDPATH",dirlist)) {
X	return(SS$_NORMAL);
X    }
X    else {
X	do {
X	    startname = strrchr(dirlist,' ');
X	    if (!startname) {
X		strcpy(todir,dirlist);
X		*dirlist = '\0';
X	    }
X	    else {
X		strcpy(todir,startname+1);
X		do {
X		   *(startname--) = '\0';
X		} while (startname >= dirlist && startname == ' ');
X	    }
X	    strcat(todir,"*.dir");
X	    context = 0;
X	    while (findfile(todir,target,&context)) {
X		endname = strchr(target,' ');
X		*endname = '\0';
X		startname = strrchr(target,']')+1;
X		endname = strrchr(target,'.');
X		i = endname-startname;
X		strncpy(dirname,startname,i);
X		dirname[i] = '\0';
X		*(startname-1) = '\0';
X		strcat(target,".");
X		strcat(target,dirname);
X		strcat(target,"]");
X		setlogical(dirname,target);
X	    }
X	} while (*dirlist);
X    }
X}
Xfindfile(file_name,result_name,context)
Xchar *file_name,*result_name;
Xint *context;
X{   int status;
X
X    setdesc(&desc,file_name,strlen(file_name));
X    setdesc(&desc1,result_name,MAXSTRING);
X    status = lib$find_file(&desc,&desc1,context,0,0,0,0);
X    if (status & STS$M_SUCCESS) {
X	return(1);
X    }
X    else {
X	return(0);
X    }
X}
Xgetlogical(logical_name,value)
Xchar *logical_name,*value;
X{   int valuelen;
X    char cap_name[MAXSTRING];
X
X    upshift(cap_name,logical_name);
X    setdesc(&desc,cap_name,strlen(cap_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    lib$sys_trnlog(&desc,&valuelen,&desc1,0,0,0);
X    value[valuelen] = '\0';
X    if (!strcmp(cap_name,value)) {
X	return(0);
X    }
X    return(1);
X
X}
Xgetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int valuelen,status;
X    char cap_name[MAXSTRING];
X
X    upshift(cap_name,symbol_name);
X    setdesc(&desc,cap_name,strlen(cap_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    status = lib$get_symbol(&desc,&desc1,&valuelen,0);
X    if (status & STS$M_SUCCESS) {
X	value[valuelen] = '\0';
X	return(1);
X    }
X    else {
X	return(0);
X    }
X}
Xsetdesc(descr,str,strlen)
Xstruct dsc$descriptor_s *descr;
Xchar *str;
Xint strlen;
X{
X    descr->dsc$w_length = strlen;
X    descr->dsc$a_pointer = str;
X    descr->dsc$b_class = DSC$K_CLASS_S;	/* String desc class */
X    descr->dsc$b_dtype = DSC$K_DTYPE_T;	/* Ascii string type */
X}
Xsetlogical(logical_name,value)
Xchar *logical_name,*value;
X{   int valuelen;
X    char cap_name[MAXSTRING];
X
X    upshift(cap_name,logical_name);
X    setdesc(&desc,cap_name,strlen(cap_name));
X    setdesc(&desc1,value,strlen(value));
X    lib$set_logical(&desc,&desc1,0);
X}
Xupshift(upname,lwname)
Xchar *upname,*lwname;
X{
X    while(*(upname++) = toupper(*(lwname++)));
X}
/
echo 'x - popd.c'
sed 's/^X//' > popd.c << '/'
X#define NULL 0
X#define MAXSTRING 132
X
X#include <rms.h>
X#include <stdio.h>
X#include <stsdef.h>
X#include <ssdef.h>
X#include <descrip.h>
X
Xstruct dsc$descriptor_s desc,desc1;
X
Xmain (argc,argv)
X    int argc;
X    char **argv;
X
X{   char dirlist[MAXSTRING],todir[MAXSTRING],*last_dir;
X
X    if (!getlogical("dir_stack",dirlist)) {
X	invalid_pop();
X	return(1);
X    }
X    else {
X	last_dir = strchr(dirlist,',');
X	if (!last_dir) {
X	    strcpy(todir,dirlist);
X	    *dirlist = '\0';
X	}
X	else {
X	    *last_dir = '\0';
X	    strcpy(todir,dirlist);
X	    strcpy(dirlist,last_dir+1);
X	}
X	chdir_and_new_stack(todir,dirlist);
X    }
X    
X}
Xdellogical(logical_name)
Xchar *logical_name;
X{   char cap_name[MAXSTRING];
X
X    upshift(cap_name,logical_name);
X    setdesc(&desc,cap_name,strlen(cap_name));
X    lib$delete_logical(&desc,0);
X}
Xdelsymbol(symbol_name)
Xchar *symbol_name;
X{   int tbl;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    tbl = 2;
X    lib$delete_symbol(&desc,&tbl);
X}
Xgetlogical(logical_name,value)
Xchar *logical_name,*value;
X{   int valuelen;
X    char cap_name[MAXSTRING];
X
X    upshift(cap_name,logical_name);
X    setdesc(&desc,cap_name,strlen(cap_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    lib$sys_trnlog(&desc,&valuelen,&desc1,0,0,0);
X    value[valuelen] = '\0';
X    if (!strcmp(cap_name,value)) {
X	return(0);
X    }
X    return(1);
X
X}
Xgetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int valuelen,status;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    status = lib$get_symbol(&desc,&desc1,&valuelen,0);
X    if (status & STS$M_SUCCESS) {
X	value[valuelen] = '\0';
X	return(1);
X    }
X    else {
X	return(0);
X    }
X}
Xinvalid_pop()
X{
X    fprintf(stderr,"empty stack\n");
X}
Xsetdesc(descr,str,strlen)
Xstruct dsc$descriptor_s *descr;
Xchar *str;
Xint strlen;
X{
X    descr->dsc$w_length = strlen;
X    descr->dsc$a_pointer = str;
X    descr->dsc$b_class = DSC$K_CLASS_S;	/* String desc class */
X    descr->dsc$b_dtype = DSC$K_DTYPE_T;	/* Ascii string type */
X}
Xsetlogical(logical_name,value)
Xchar *logical_name,*value;
X{   char cap_name[MAXSTRING];
X
X    upshift(cap_name,logical_name);
X    setdesc(&desc,cap_name,strlen(cap_name));
X    setdesc(&desc1,value,strlen(value));
X    lib$set_logical(&desc,&desc1,0);
X}
Xsetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int tbl;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    setdesc(&desc1,value,strlen(value));
X    tbl = 2;
X    lib$set_symbol(&desc,&desc1,&tbl);
X}
Xupshift(upname,lwname)
Xchar *upname,*lwname;
X{
X    while (*(upname++) = toupper(*(lwname++)));
X}
Xchdir_and_new_stack(todir,pushstack)
Xchar *todir,*pushstack;
X{
X    if (*pushstack) {
X	setlogical("dir_stack",pushstack);
X    }
X    else {
X	dellogical("dir_stack");
X    }
X
X    printf("%s\n",todir);
X    chdir(todir,1);
X}
/
echo 'Part 02 of vms complete.'
exit



More information about the Mod.sources mailing list