Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!seismo!rutgers!sri-spam!ames!ucbcad!ucbvax!CITHEX.CALTECH.EDU!carl
From: carl@CITHEX.CALTECH.EDU (Carl J Lydick)
Newsgroups: comp.os.vms
Subject: Re: code to set file protection
Message-ID: <870629062054.003@CitHex.Caltech.Edu>
Date: Mon, 29-Jun-87 09:23:12 EDT
Article-I.D.: CitHex.870629062054.003
Posted: Mon Jun 29 09:23:12 1987
Date-Received: Tue, 30-Jun-87 07:10:10 EDT
References: <1663@uwmacc.UUCP>
Sender: daemon@ucbvax.BERKELEY.EDU
Distribution: world
Organization: The ARPA Internet
Lines: 48

Oops.  Somehow my earlier response managed to get away without the promised
code.  Here it is:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/* CHMOD -- SET	PROTECTION, UNIX style */
#define	RME$C_SETRFM 0X00000001
#include xab.h				  
#include <fab.h>
main(nargs, args)
int nargs;
char **args;
{	struct FAB myfab = cc$rms_fab;
	unsigned short mode;
	unsigned long status;
	struct XABPRO myxab = cc$rms_xabpro;
	if (--nargs < 2	|| sscanf(*++args,"%o%c", &mode, &status) != 1)
		exit((puts("USAGE: CHMOD mode file [file...]"),1));
/* Convert UNIX-style octal mode to VMS	protection mask	*/
/*	First, move unused,owner,group,world to world,group,owner,system 
		using owner protection for system as well */
	mode = (((mode & 0007) << 12) |	((mode & 0070) << 5) |
		((mode & 0700) >> 2)  |	((mode & 0700) >> 6));
/*	Then move unused,read,write,execute to delete,execute,write,read
		using write access for delete	as well, then complement */
	mode = ~(((mode	& 0x1111) << 2)	| ((mode & 0x2222)) | 
		 ((mode	& 0x2222) << 2)	| ((mode & 0x4444) >> 2));
/* Initialize fab block	*/
	myfab.fab$l_xab	= &myxab;
	myfab.fab$b_fac	= FAB$M_UPD;
	myfab.fab$l_fop	|= FAB$M_ESC;
	myfab.fab$l_ctx	|= RME$C_SETRFM;
	myfab.fab$w_ifi	= 0;
	while (--nargs > 0) {
/* Set up fab for next file */
		myfab.fab$l_fna	= *++args;
		myfab.fab$b_fns	= strlen(*args);
/* Open	the file */
		if (((status = SYS$OPEN(&myfab,	0, 0)) & 7) != 1)
			exit((printf("Couldn't open %s\n", *args), status));
/* Set the protection field in the XAB */
		myxab.xab$w_pro	= mode;
/* Update the file header */
		if (((status = SYS$MODIFY(&myfab, 0, 0)) & 7) != 1)
			exit((printf("Couldn't modify %s\n", *args), status));
/* Close the file */
		if (((status = SYS$CLOSE(&myfab, 0, 0))	& 7) !=	1)
			exit((printf("Couldn't close %s\n", *args), status));
	}
}