# read list of pathnames on stdin, write POSIX.1 tar on stdout
# Copyright(c)1996 Lucent Technologies.  All Rights Reserved.
# 22 Dec 1996 ehg@bell-labs.com

implement puttar;
include "sys.m";
	sys: Sys;
	print, sprint, fprint: import sys;
	stdout, stderr: ref sys->FD;
include "draw.m";
include "bufio.m";
	bufio: Bufio;
	Iobuf: import bufio;

puttar: module{
	init:   fn(nil: ref Draw->Context, nil: list of string);
};

Warning(mess: string)
{
	fprint(stderr,"warning: puttar: %s: %r\n",mess);
}

Error(mess: string){
	fprint(stderr,"puttar: %s: %r\n",mess);
	exit;
}

TBLOCK: con 512;	# tar logical blocksize
NBLOCK: con 20;		# blocking factor for efficient write
tarbuf := array[NBLOCK*TBLOCK] of byte;	# for output
nblock := 0;		# how many blocks of data are in tarbuf

flushblocks(){
	if(nblock<=0) return;
	if(nblock<NBLOCK){
		for(i:=(nblock+1)*TBLOCK;i<NBLOCK*TBLOCK;i++)
			tarbuf[i] = byte 0;
	}
	i := sys->write(stdout,tarbuf,NBLOCK*TBLOCK);
	if(i!=NBLOCK*TBLOCK)
		Error("write error");
	nblock = 0;
}

putblock(data:array of byte){
	# all writes are done through here, so we can guarantee
	#              10kbyte blocks if writing to tape device
	if(len data!=TBLOCK)
		Error("putblock wants TBLOCK chunks");
	tarbuf[nblock*TBLOCK:] = data;
	nblock++;
	if(nblock>=NBLOCK)
		flushblocks();
}

packname(hdr:array of byte, name:string){
	utf := array of byte name;
	n := len utf;
	if(n<=100){
		hdr[0:] = utf;
		return;
	}
	for(i:=n-101; i<n && int utf[i] != '/'; i++){}
	if(i==n) Error(sprint("%s > 100 bytes",name));
	if(i>155) Error(sprint("%s too long\n",name));
	hdr[0:] = utf[i+1:n];
	hdr[345:] = utf[0:i];  # tar supplies implicit slash
}

octal(width:int, val:int):array of byte{
	octal := array of byte "01234567";
	a := array[width] of byte;
	for(i:=width-1; i>=0; i--){
		a[i] = octal[val&7];
		val >>= 3;
	}
	return a;
}

chksum(hdr: array of byte):int{
	sum := 0;
	for(i:=0; i<len hdr; i++)
		sum += int hdr[i];
	return sum;
}

hdr, zeros, ibuf : array of byte;

tar(file : string, dir: Sys->Dir, fd: ref Sys->FD)
{
	hdr[0:] = zeros;
	packname(hdr,file);
	hdr[100:] = octal(7,dir.mode&8r777);
	hdr[108:] = octal(7,1);
	hdr[116:] = octal(7,1);
	hdr[124:] = octal(11,int dir.length);
	hdr[136:] = octal(11,dir.mtime);
	hdr[148:] = array of byte "        "; # for chksum
	hdr[156] = byte '0';
	if(dir.mode&Sys->DMDIR) hdr[156] = byte '5';
	hdr[257:] = array of byte "ustar";
	hdr[263:] = array of byte "00";
	hdr[265:] = array of byte dir.uid; # assumes len uid<=32
	hdr[297:] = array of byte dir.gid;
	hdr[329:] = octal(8,dir.dev);
	hdr[337:] = octal(8,int dir.qid.path);
	hdr[148:] = octal(7,chksum(hdr));
	hdr[155] = byte 0;
	putblock(hdr);
	for(bytes := int dir.length; bytes>0;){
		n := len ibuf;  if(n>bytes) n = bytes;  # min
		if(sys->read(fd,ibuf,n)!=n)
			Error(sprint("read %s: %r",file));
		nb := (n+TBLOCK-1)/TBLOCK;
		fill := nb*TBLOCK;
		for(i:=n; i<fill; i++) ibuf[i] = byte 0;
		for(i=0; i<nb; i++)
			putblock(ibuf[i*TBLOCK:(i+1)*TBLOCK]);
		bytes -= n;
	}
	fd = nil;
}

rtar(file : string)
{
	(ok, dir) := sys->stat(file);
	if (ok < 0){
		Warning(sprint("cannot stat %s", file));
		return;
	}
	fd := sys->open(file, sys->OREAD);
	if (fd == nil){
		Warning(sprint("cannot open %s", file));
		return;
	}
	tar(file, dir, fd);

	if((dir.mode & Sys->DMDIR) == 0)
		return;

	for (;;) {
		(n, d) := sys->dirread(fd);
		if (n < 0)
			Error(sprint("read %s: %r",file));
		if (n == 0)
			break;
		for (i := 0; i < n; i++) {
			if (file[len file - 1] == '/')
				rtar(file + d[i].name);
			else
				rtar(file + "/" + d[i].name);
		}
	}
}

init(nil: ref Draw->Context, args: list of string){
	sys = load Sys Sys->PATH;
	bufio = load Bufio Bufio->PATH;
	stdout = sys->fildes(1);
	stderr = sys->fildes(2);
	
	hdr = array[TBLOCK] of byte;
	zeros = array[TBLOCK] of {* => byte 0};
	ibuf = array[len tarbuf] of byte;

	if (tl args == nil) {
		stdin := bufio->fopen(sys->fildes(0),bufio->OREAD);
		if(stdin==nil) Error("can't fopen stdin");
		while((file := stdin.gets('\n'))!=nil){
			if(file[len file-1]=='\n') file = file[0:len file-1];
			(ok, dir) := sys->stat(file);
			if(ok < 0) {
				Warning(sprint("cannot stat %s", file));
				continue;
			}
			fd := sys->open(file, sys->OREAD);
			if (fd == nil){
				Warning(sprint("cannot open %s", file));
				return;
			}
			tar(file, dir, fd);
		}
	}
	else {
		for (args = tl args; args != nil; args = tl args)
			rtar(hd args);
	}
	putblock(zeros);
	putblock(zeros);	# format requires two empty blocks at end
	flushblocks();
}