ftp.nice.ch/pub/next/developer/languages/lisp/AKCL.1.599.s.tar.gz#/akcl-1-599/c/filesystem.c

This is filesystem.c in view mode; [Download] [Up]

/*
(C) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
*/

/*
	filesystem.c
	DG-SPECIFIC
*/

#include "packets:filestatus.h"
#include "include.h"

#define $FLNK	00  /* LINK */
#define $FIPC	036  /* IPC PORT ENTRY */
#define $FDIR	012  /* DISK DIRECTORY */
#define $FLDU	013  /* LD ROOT DIRECTORY */
#define $FCPD	014  /* CONTROL POINT DIRECTORY */
#define $FDKU	024  /* DISK UNIT */
#define $FMCU	025  /* MULTIPROCESSOR COMMUNICATIONS UNIT */
#define $FMTU	026  /* MAG TAPE UNIT */
#define $FLPU	027  /* DATA CHANNEL LINE PRINTER */
#define $FLPD	030  /* DATA CHANNEL LP2 UNIT */

#define EREOF	030  /* END OF FILE */
#define ERFDE	025  /* FILE DOES NOT EXIST */

#define $MXPL	0400  /* MAX PATHNAME LENGTH (BYTES) */

#define  $DELETE      01     /* DELETE FILE */
#define  $RENAME      02     /* RENAME A FILE */
#define  $GUNM       072     /* GET A PROCESS'S USER NAME */
#define  $DIR        075     /* CHANGE WORKING DIRECTORY */
#define  $FSTAT      077     /* GET FILE STATUS */
#define  $GNAME     0111     /* GET FULL PATHNAME */
#define  $GACL      0115     /* GET A FILE'S ACL */
#define  $GNFN      0131     /* GET NEXT FILE NAME FROM DIR */

#define MAXNAME 256

union fstat {
	P_FSTAT other;
	P_FSTAT_DIR dir;
	P_FSTAT_IPC ipc;
	P_FSTAT_UNIT unit;
	};

int	debug;

rename_file(filen, newname)
char *filen, *newname;
{
	int ac0, ac1, ac2, ier;

	ac0 = filen;
	ac1 = newname;
	if (ier = sys($RENAME, &ac0, &ac1, &ac2))
		sys_emes(ier);
}

delete_file(filen)
char *filen;
{
	int ac0, ac1, ac2, ier;

	ac0 = filen;
	if (ier = sys($DELETE, &ac0, &ac1, &ac2))
		sys_emes(ier);
}

probe_file(filen, truename, bufflen)
char *filen, *truename;
int bufflen;
{
	int ac0, ac1, ac2, ier;

	ac0 = filen;
	ac1 = truename;
	ac2 = bufflen;
	if (ier = sys($GNAME, &ac0, &ac1, &ac2))
		if (ier == ERFDE)
			return(FALSE);
		else
			sys_emes(ier);
	return(TRUE);
}

int
dir_where_file(filen, dirn)
char *filen, *dirn;
{
	int	ac0, ac1, ac2, ier;
	int	i, j, d, d1;
	char	slist[$MXPL+2];
	char	pathn[MAXNAME];
	char	dummy[MAXNAME];

	slist[0] = '=';
	slist[1] = '\0';

	ac1 = &slist[2];
	ac2 = $MXPL + 2;
	if (ier = sys($GLIST, &ac0, &ac1, &ac2))
		sys_emes(ier);

	d = d1 = 0;
	for (d = d1 = 0; ; d1 = d) {
		for (i = 0; (pathn[i] = slist[d]) != '\0'; i++, d++)
			;
		if (i == 0) return(FALSE);
		d++;
		for (j = 0; (pathn[i] = filen[j]) != '\0'; i++, j++)
			;
		if (probe_file(pathn, dummy, MAXNAME)) break;
	}
	probe_file(&slist[d1], dirn, MAXNAME);
	return(TRUE);
}

FILE *
backup_fopen(filen, open_opt)
char *filen, *open_opt;
{
	int	ac0, ac1, ac2, ier;
	int	i, j;
	object	p, d, f;
	FILE	*fd;
	char	*c;
	char	filename[MAXNAME], dirn[MAXNAME];
	char	buname[MAXNAME];
	vs_mark;

	p = make_simple_string(filen);
	vs_push(p);
	p = coerce_to_pathname(p);
	vs_pop;
	vs_push(p);
	f = make_pathname(Cnil, Cnil, Cnil,
			  p->pn.pn_name,
			  p->pn.pn_type,
			  p->pn.pn_version);
	vs_push(f);
	f = coerce_to_namestring(f);
	vs_pop;
	vs_push(f);

	if (f == Cnil)
		FEerror("Zero length filename was specified.", 0);

	c = f->st.st_self;
	j = f->st.st_fillp;

	filename[0] = '=';
	for (i = 0; i < j; i++)
		filename[i+1] = c[i];
	filename[i+1] = '\0';

	if (p->pn.pn_directory == Cnil)
		if (!dir_where_file(filen, dirn))
			sys_emes(ERFDE);
		else
			;
	else {
		d = make_pathname(Cnil, Cnil,
				  p->pn.pn_directory,
				  Cnil, Cnil, Cnil);
		vs_push(d);
		d = coerce_to_namestring(d);
		c = d->st.st_self;
		j = d->st.st_fillp;
		for (i = 0; i < j; i++)
			dirn[i] = c[i];
		if (i > 0 && dirn[i-1] == ':') i--;
		dirn[i] = '\0';
	}
	ac0 = dirn;
	if (ier = sys($DIR, &ac0, &ac1, &ac2))
		sys_emes(ier);
	for (i = 0; (buname[i] = filename[i+1]) != '\0'; i++)
		;
	buname[i++] = '.';
	buname[i++] = 'B';
	buname[i++] = 'U';
	buname[i] = '\0';

	ac0 = buname;
	if ((ier = sys($DELETE, &ac0, &ac1, &ac2)) != NULL &&
	    ier != ERFDE)
			sys_emes(ier);
	rename_file(filename, buname);

	fd = fopen(filename, open_opt);

	ac0 = 0;
	if (ier = sys($DIR, &ac0, &ac1, &ac2))
		sys_emes(ier);

	vs_reset;
	return(fd);
}

get_file_status(filen, filep)
char *filen;
P_FSTAT *filep;
{
	int ac0, ac1, ac2, ier;

	ac0 = filen;
	ac1 = 0;
	ac2 = filep;
	if (ier = sys($FSTAT, &ac0, &ac1, &ac2))
		sys_emes(ier);
}

get_file_status_chan(fd, filep)
FILE *fd;
P_FSTAT *filep;
{
	int ac0, ac1, ac2, ier;

	ac0 = fchannel(fd);
	ac1 = 020000000000;	/* channel in ac0 */
	ac2 = filep;
	if (ier = sys($FSTAT, &ac0, &ac1, &ac2))
		sys_emes(ier);
}

object
file_write_date(filen)
char *filen;
{
	union	fstat filep;
	unsigned char ftype;
	short	dd, tt;
	object	time, time_zone, time_gap;

	get_file_status(filen, &filep);
	ftype = filep.other.styp_type;
	switch(ftype) {
	case $FIPC:
			dd = filep.ipc.stch.short_time[_DATE];
			tt = filep.ipc.stch.short_time[_TIME];
			break;
	case $FLDU:
	case $FDIR:
	case $FCPD:
			dd = filep.dir.stmh.short_time[_DATE];
			tt = filep.dir.stmh.short_time[_TIME];
			break;
	case $FDKU:
	case $FMCU:
	case $FMTU:
	case $FLPU:
	case $FLPD:
			dd = filep.unit.stch.short_time[_DATE];
			tt = filep.unit.stch.short_time[_TIME];
			break;
	default:
			dd = filep.other.stmh.short_time[_DATE];
			tt = filep.other.stmh.short_time[_TIME];
			break;
	}
	time = make_fixnum((dd - 1) * 24 * 3600 + tt * 2);
					/* tt is bi-seconds */
	vs_push(time);
	time_gap = make_fixnum(2145830400);
	vs_push(time_gap);
	time = number_plus(time, time_gap);
	vs_pop;
	vs_pop;
	vs_push(time);
	time_zone = make_fixnum(TIME_ZONE * 3600);
	vs_push(time_zone);
	time = number_plus(time, time_zone);
	vs_pop;
	vs_pop;

	return(time);
}

int
file_len(fd)
FILE *fd;
{
	union fstat filep;
	unsigned char ftype;

	get_file_status_chan(fd, &filep);
	ftype = filep.other.styp_type;
	switch(ftype) {
	case $FIPC:
	case $FDKU:
	case $FMCU:
	case $FMTU:
	case $FLPU:
	case $FLPD:
			return(-1);
	case $FLDU:
	case $FDIR:
	case $FCPD:
			return(filep.dir.sefm);
	default:
			return(filep.other.sefm);
	}

}

file_author(filen, author)
char *filen, *author;
{
	char	aclbuf[256];
	char	*up, *ap, *bp;
        int	ac0, ac1, ac2, ier;
	int	i;

	for (i = 0; i < 256; i++) aclbuf[i] = '\0';
	ac0 = filen;
	ac1 = aclbuf;
	if (ier = sys($GACL, &ac0, &ac1, &ac2))
		sys_emes(ier);
	bp = author;
	for (up = aclbuf; ;up = ap + 1) {
		for (ap = up; *ap != '\0'; ap++)
			;
		if (up == ap) break;
		ap++;
		if (*ap & $FACO) {
			if (bp != author) *bp++ = ',';
			for (i = 0; up[i] != '\0'; i++)
				*bp++ = up[i];
		}
	}
	if (bp == author)
		return(FALSE);
	else {
		*bp = '\0';
		return(TRUE);
	}
}

username(uname)
char *uname;
{
	int	ac0, ac1, ac2, ier;

	ac0 = -1;
	ac1 = 1;
	ac2 = uname;
	if (ier = sys($GUNM, &ac0, &ac1, &ac2))
		sys_emes(ier);
}

object
truename(file)
object file;
{
	object x;
	char filen[MAXNAME], pathn[MAXNAME];
	int i, j;
	char *c;

	x = coerce_to_namestring(file);
	vs_push(x);
	for (i = 0, j = x->st.st_fillp, c = x->st.st_self; i < j; i++)
		filen[i] = c[i];
	if (i > 1 && filen[i - 1] == ':') i--;
	filen[i] = '\0';
	if (!probe_file(filen, pathn, MAXNAME))
		sys_emes(ERFDE);
	x = make_simple_string(pathn);
	vs_pop;
	vs_push(x);
	x = coerce_to_pathname(x);
	vs_pop;
	return(x);
}

int
file_exists(file)
object file;
{
	char filen[MAXNAME], pathn[MAXNAME];
	int i, j;
	char *c;

	if (type_of(file) != t_string)
		FEwrong_type_argument(Sstring, file);

	for (i = 0, j = file->st.st_fillp, c = file->st.st_self;
	     i < j; i++)
		filen[i] = c[i];
	if (i > 1 && filen[i-1] == ':') i--;
	filen[i] = '\0';
	return(probe_file(filen, pathn, MAXNAME));
}

Ltruename()
{
	check_arg(1);
	check_type_or_pathname_string_symbol_stream(&vs_base[0]);
	vs_base[0] = truename(vs_base[0]);
}

Luser_homedir_pathname()
{
	int	i, args;
	object	x;
	char	usern[MAXNAME], dirn[MAXNAME];

	args = vs_top - vs_base;
	if (args > 1) too_many_arguments();
	if (args == 1) {
		check_type_or_pathname_string_symbol_stream(&vs_base[0]);
		if (vs_base[0] != Cnil) {
			vs_base[0] = Cnil;
			return;
		}
	}
	username(usern);
	dirn[0] = dirn[4] = ':';
	dirn[1] = 'U';
	dirn[2] = dirn[3] = 'D';
	for (i = 0; (dirn[i+5] = usern[i]) != '\0';i++)
		;
	i += 5;
	dirn[i++] = ':';
	dirn[i] = '\0';
	x = make_simple_string(dirn);
	vs_push(x);
	x = coerce_to_pathname(x);
	vs_top = vs_base;
	vs_push(x);
}

Lrename_file()
{
	object	old, new, new1, truename_old, truename_new;
	int	i, j;
	char	*c;
	char	oldn[MAXNAME], newn[MAXNAME];

	check_arg(2);
	check_type_or_pathname_string_symbol_stream(&vs_base[0]);
	check_type_or_pathname_string_symbol_stream(&vs_base[1]);

	new1 = vs_base[1];
	if (type_of(new1) == t_stream)
		FEerror("A filename is expected.", 0);
	new1 = coerce_to_pathname(new1);
	if (new1->pn.pn_host != Cnil ||
	    new1->pn.pn_device != Cnil ||
	    new1->pn.pn_directory != Cnil)
		FEerror("A filename is expected.", 0);
	vs_push(new1);

	new = namestring(new1);
	j = new->st.st_fillp;
	c = new->st.st_self;
	for (i = 0; i < j; i++)
		newn[i] = c[i];
	newn[i] = '\0';

	truename_old = truename(vs_base[0]);
	vs_push(truename_old);
	truename_old = coerce_to_pathname(truename_old);
	vs_pop;
	vs_push(truename_old);

	old = coerce_to_namestring(vs_base[0]);
	j = old->st.st_fillp;
	c = old->st.st_self;
	for (i = 0; i < j; i++)
		oldn[i] = c[i];
	oldn[i] = '\0';

	rename_file(oldn, newn);

	old = coerce_to_pathname(vs_base[0]);
	vs_push(old);
	new = make_pathname(
		old->pn.pn_host,
		old->pn.pn_device,
		old->pn.pn_directory,
		new1->pn.pn_name,
		new1->pn.pn_type,
		old->pn.pn_version);
	vs_push(new);
	truename_new = truename(new);

	vs_top = vs_base;
	vs_push(new);
	vs_push(truename_old);
	vs_push(truename_new);
}

Ldelete_file()
{
	int	i, j;
	char	*c;
	char	pathn[MAXNAME];
	char	truen[MAXNAME];

	check_arg(1);
	check_type_or_pathname_string_symbol_stream(&vs_base[0]);
	vs_base[0] = coerce_to_namestring(vs_base[0]);
	j = vs_base[0]->st.st_fillp;
	c = vs_base[0]->st.st_self;
	for (i = 0; i < j; i++)
		pathn[i] = c[i];
	if (i > 1 && pathn[i-1] == ':') i--;
	pathn[i] = '\0';
	probe_file(pathn, truen, MAXNAME);
	delete_file(truen);
	vs_base[0] = Ct;
}

Lprobe_file()
{
	int	i, j, dirflg;
	char	*c;
	char	filen[MAXNAME], pathname[MAXNAME];

	check_arg(1);
	check_type_or_pathname_string_symbol_stream(&vs_base[0]);
	vs_base[0] = coerce_to_namestring(vs_base[0]);
	c = vs_base[0]->st.st_self;
	j = vs_base[0]->st.st_fillp;
	for (i = 0; i < j; i++)
		filen[i] = c[i];
	if (i > 1 && filen[i-1] == ':') {
		i--;
		dirflg = TRUE;
	} else
		dirflg = FALSE;
	filen[i] = '\0';
	if (!probe_file(filen, pathname, MAXNAME)) {
		vs_base[0] = Cnil;
		return;
	}
	if (dirflg) {
		for (i = 0; pathname[i] != '\0'; i++)
			;
		pathname[i++] = ':';
		pathname[i] = '\0';
	}
	vs_base[0] = make_simple_string(pathname);
	vs_base[0] = coerce_to_pathname(vs_base[0]);
}

Lfile_write_date()
{
	int	i, j;
	char	*c;
	char	filen[MAXNAME];

	check_arg(1);
	check_type_or_pathname_string_symbol_stream(&vs_base[0]);
	vs_base[0] = coerce_to_namestring(vs_base[0]);
	c = vs_base[0]->st.st_self;
	j = vs_base[0]->st.st_fillp;
	for (i = 0; i < j; i++)
		filen[i] = c[i];
	if (i > 1 && filen[i-1] == ':') i--;
	filen[i] = '\0';
	vs_base[0] = file_write_date(filen);
}

Lfile_author()
{
	int	i, j;
	char	*c;
	char	filen[MAXNAME];
	char	author[MAXNAME];

	check_arg(1);
	check_type_or_pathname_string_symbol_stream(&vs_base[0]);
	vs_base[0] = coerce_to_namestring(vs_base[0]);
	c = vs_base[0]->st.st_self;
	j = vs_base[0]->st.st_fillp;
	for (i = 0; i < j; i++)
		filen[i] = c[i];
	if (i > 1 && filen[i-1] == ':') i--;
	filen[i] = '\0';
	if (file_author(filen, author))
		vs_base[0] = make_simple_string(author);
	else
		vs_base[0] = Cnil;

}

Ldirectory()
{
	int	ac0, ac1, ac2, ier;
	int	i, j;
	char	dirn[MAXNAME], template[MAXNAME];
	char	filen[MAXNAME], temp[MAXNAME];
	char	*c;
	FILE	*fd;
	P_GNFN	gnfnp;
	object	d, s;

	check_arg(1);
	check_type_or_pathname_string_symbol_stream(&vs_base[0]);

	gnfnp.nfky = 0;
	gnfnp.nfrs = 0;
	gnfnp.nfnm = filen;
	gnfnp.nftp = -1;

	vs_base[0] = coerce_to_pathname(vs_base[0]);
	if (vs_base[0]->pn.pn_directory == Cnil) {
		temp[0] = '=';
		temp[1] = '\0';
		probe_file(temp, dirn, MAXNAME);
	} else {
		d =
		make_pathname(Cnil, Cnil,
			      vs_base[0]->pn.pn_directory,
			      Cnil, Cnil, Cnil);
		vs_push(d);
		s = coerce_to_namestring(d);
		vs_pop;
		j = s->st.st_fillp;
		c = s->st.st_self;
		for (i = 0; i < j; i++)
			temp[i] = c[i];
		if (i > 1 && temp[i-1] == ':')
			i--;
		temp[i] = '\0';
		if (!probe_file(temp, dirn, MAXNAME)) {
			vs_top = vs_base;
			vs_push(Cnil);
			return;
		}
	}

	if (vs_base[0]->pn.pn_name == Cnil &&
	    vs_base[0]->pn.pn_type == Cnil)
		gnfnp.nftp = -1;
	else {
		s = make_pathname(Cnil, Cnil, Cnil,
				  vs_base[0]->pn.pn_name,
				  vs_base[0]->pn.pn_type,
				  vs_base[0]->pn.pn_version);
		vs_push(s);
		s = namestring(s);
		vs_pop;
		gnfnp.nftp = template;
		j = s->st.st_fillp;
		c = s->st.st_self;
		for (i = 0; i < j; i++)
			template[i] = c[i];
		template[i] = '\0';
	}

	if ((fd = fopen(dirn, "r")) == NULL) {
		if ((ier = lasterror()) == ERFDE) {
			vs_top = vs_base;
			vs_push(Cnil);
			return;
		}
		sys_emes(ier);
	}
	for (i = 0; (temp[i] = dirn[i]) != '\0'; i++)
		;
	if (i > 1) temp[i++] = ':';	/* not root directory ? */
	j = i;
	ac0 = 0;
	ac1 = fchannel(fd);
	ac2 = &gnfnp;
	vs_top = vs_base;
	vs_push(Cnil);
	vs_push(Cnil);
	while ((ier = sys($GNFN, &ac0, &ac1, &ac2)) == NULL) {
		for (i = 0; (temp[j+i] = filen[i]) != '\0'; i++)
			;
		probe_file(temp, filen, MAXNAME);
		vs_base[1] = make_simple_string(filen);
		vs_base[1] = coerce_to_pathname(vs_base[1]);
		vs_base[0] = make_cons(vs_base[1], vs_base[0]);
	}
	fclose(fd);
	if (ier == EREOF) {
		vs_top = vs_base + 1;
		return;
	} else
		sys_emes(ier);
}

init_filesystem()
{
	make_function("TRUENAME", Ltruename);
	make_function("USER-HOMEDIR-PATHNAME", Luser_homedir_pathname);
	make_function("RENAME-FILE", Lrename_file);
	make_function("DELETE-FILE", Ldelete_file);
	make_function("PROBE-FILE", Lprobe_file);
	make_function("FILE-WRITE-DATE", Lfile_write_date);
	make_function("FILE-AUTHOR", Lfile_author);
	make_function("DIRECTORY", Ldirectory);
}

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.