Path: utzoo!utgpu!watserv1!watmath!att!rutgers!mcnc!uvaarpa!mmdf
From: eichin@athena.mit.edu (Mark W. Eichin)
Newsgroups: comp.lang.perl
Subject: perl tar file routines (perltar.perl)
Message-ID: <1990Jul15.235710.14293@uvaarpa.Virginia.EDU>
Date: 15 Jul 90 23:57:10 GMT
Sender: mmdf@uvaarpa.Virginia.EDU (Uvaarpa Mail System)
Reply-To: eichin@athena.mit.edu
Organization: The Internet
Lines: 224

Gee, if I had posted this a few weeks ago when I wrote it, you might have been
saved some time. I guess it's time to inflict it upon the world of Perl...

Story: SIMTEL20 is far away from almost *everything* on the network. I
typically get connections at around 4800 *baud* from MIT via NEARNET, BBN, and
what is left of MILNET... I decided I wanted a full set of the CPM archives
locally. The first problem was feeding ftp a list of names and having it get
the files; the second was not having enough space around to *hold* a full
tape's worth of data (45Meg cartridge.)

The first problem was solved admirably by Khun Yee <clipper@csd.uwo.ca> whose
"nftp.pl" you can find from around 31 May 1990. I hacked it into a library.
The second problem was solved by writing some perl code to take a string and
write it out to a file as a tar record, so I could slurp the files over from
SIMTEL20 and pushing them out directly to tape.

Following is "perltar.perl", with the appropriate subroutines. (just 
	do 'perltar.perl'; 
and then use them. Comments on my subroutine style are welcomed; is there a
better way to make perl code *modular* and have rudimentary abstraction?)

When writing, to write an EOF at the end of the tape, remember to do a 
	print pack("x8192",1);
before you close your output. (I had trouble with print pack("x8192"); should
I have?)
			Mark Eichin
			<eichin@athena.mit.edu>
			MIT Student Information Processing Board

# perltar.perl
# Perl functions for dealing with tar files
#
# write tar header (given name)
# write file

sub TBLOCK {512;}
sub NAMSIZ {100;}
	
### $chksum =~ s/^\s+//;

# int tar_oct(string) 
# takes: an octal string w/leading spaces
# gives: integer value
sub tar_oct {
	local($ll)=$_[0];
	oct((@tmp=split(" ",$ll))[0]);
}

# string hum_time(int)
# takes: integer time value (UNIX seconds since EPOCH)
# gives: "human readable" time (the way tar does it.)
sub hum_time { 
	local($mt)=$_[0];
	local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
		localtime($mt);
        sprintf("%s %2d %02d:%2d %4d",
		("Jan","Feb","Mar","Apr","May","Jun",
		 "Jul","Aug","Sep","Oct","Nov","Dec")[$mon],
		$mday,$hour,$min,$year+1900);
}

# int sum_chars(string)
# takes: a string of characters
# gives: integer sum of ASCII values of the characters
sub sum_chars {
	local($chrs)=$_[0];
	local($len)=length($chrs);
	local(@bytes)=unpack("C$len",$chrs);
	local($i,$cnt); $cnt=0;
	foreach $i (@bytes) { $cnt += $i; }
	$cnt;
}


# status,tar_struct read_tar_header(string)
# takes: 512 byte tar block
# gives: status={1:error,0:ok},tar data structure=
#        ($name,$mode,$uid,$gid,$size,$mtime,$chksum,$linkflag,$linkname)
sub read_tar_header {
	local($tar_block)=$_[0];
	local($tar_header)='A100A8A8A8A12A12a8A1A100';
	local(@line)=unpack($tar_header,$tar_block);
	local($zblock) = $tar_block; # unpack('A257',$tar_block);
	local($ckver)=&sum_chars($zblock)-&sum_chars($line[6])
		+&sum_chars(" " x 8);
	local($nchksum)=&tar_oct($line[6]);
	return (1, "directory checksum error $ckver != $nchksum <$line[7]>")
		if($ckver != $nchksum);
	for(1..6) { $line[$_] = &tar_oct($line[$_]); }
	(0, @line);
}

# string build_tar_header(tar_struct)
# takes: tar data structure (see above)
# gives: a string suitable for writing to a tar file.
sub build_tar_header {
	local($name,$mode,$uid,$gid,$size,$mtime,$chksum,$linkflag,$linkname)
		=@_;
	local($tar_header)='a100a8a8a8a12a12a8aa100x255';
	local($zblock)=pack($tar_header,$name,
				sprintf("%6o ",$mode),
				sprintf("%6o ",$uid),
				sprintf("%6o ",$gid),
				sprintf("%11o ",$size),
				sprintf("%11o ",$mtime),
				" " x 8,
				$linkflag, $linkname);

	$chksum = &sum_chars($zblock);
#DBG#	print "cks: <$chksum>\n";
	substr($zblock,100+8+8+8+12+12,6)=sprintf("%6o",$chksum);
	$zblock;
}

# string mode_string(int)
# takes: UNIX mode bits
# gives: rwxrwxrwx pattern
sub mode_string {
	local($bits)=$_[0];
	local(@flags)=('r','w','x','r','w','x','r','w','x');
	local($i);
	for($i=8;$i>=0;$i--) {
		$flags[$i]='-' unless($bits & 1);
		$bits >>= 1;
	}
	$flags[8]='t' if($bits & 1);
	$flags[5]='s' if($bits & 2);
	$flags[2]='s' if($bits & 4);
	pack("aaaaaaaaa",@flags);
}

# void bigprint(tar_struct)
sub bigprint {
	local($name,$mode,$uid,$gid,$size,$mtime,$chksum,$linkflag,$linkname)
		= @_;
	print "block: <$hblock>\n";
	print "Name: <$name>\n";
	$modestr = &mode_string($mode); print "mode: <$modestr>\n";
	print "uid:  <$uid>\n";
	print "gid:  <$gid>\n";
	print "size: <$size>\n";
	$htime = &hum_time($mtime); print "mtime: <$mtime> ($htime)\n";
	print "chksum: <$nchksum>\n";
	print "linkflag: <$linkflag>\n";
	print "linkname: <$linkname>\n";
}

# void tar_print(tar_struct)
sub tar_print {
	local($name,$mode,$uid,$gid,$size,$mtime,$chksum,$linkflag,$linkname)
		= @_;
	$modestr = &mode_string($mode); 
	$htime = &hum_time($mtime);
###	print "$modestr$uid/$gid $size $htime $name\n";
	if($linkflag == 0) {
		print sprintf("%s%3d/%d %6d %s %s\n",
			      $modestr,$uid,$gid,$size,$htime,$name);
	} elsif($linkflag == '1') {
		print sprintf("%s%3d/%d %6d %s %s linked to %s\n",
			      $modestr,$uid,$gid,$size,$htime,$name,$linkname);
	} elsif($linkflag == '2') {
		print sprintf("%s%3d/%d %6d %s %s symbolic link to %s\n",
			      $modestr,$uid,$gid,$size,$htime,$name,$linkname);
	}		
}

# void skip_recs(FILE,int)
# takes: file descriptor, size
sub skip_recs {
	local($FILE,$size)=@_;
	local($dump,$rlen);
#DBG#	print "looking for $size bytes in $FILE\n";
	while($size>0) {
		$rlen=read($FILE,$dump,&TBLOCK);
		if($rlen!=&TBLOCK) {
			die "short read $rlen (skip)";
		}
		$size -= &TBLOCK;
#DBG#		print "#";
	}
#DBG#	print "\n";
}

# open_tar_file(string FILE, string name, int len)
# simple hook for saving out files as tarfiles
# takes: filehandle to put tarfile to, name of file and length it will be
# gives: nothing.
sub open_tar_file {
	local($FILE,$name,$len)=@_;
	print $FILE (&build_tar_header($name,0644,$>,$),$len,time,0,"",""));
}

# tar_stuff(string INFILE, string OUTFILE, string NAME)
# takes: input from INFILE until EOF
# gives: a tar image of it on OUTFILE
# first lazy version: just suck it all into memory...
sub tar_stuff {
	local($INFILE,$OUTFILE,$NAME) = @_;
	local($buf,$contents);
	while (read($INFILE,$buf,1024)>0) {
	    $contents .= $buf;
	}
	&open_tar_file($OUTFILE,$NAME,length($contents));
	print $OUTFILE $contents;
	$fixit = 512-(length($contents) % 512);
	print $OUTFILE pack("x$fixit",1) unless ($fixit == 512);
}

# tar_mem(string data, string OUTFILE, string NAME)
# takes: input from data
# gives: a tar image of it on OUTFILE
# first lazy version: just suck it all into memory...
sub tar_mem {
	local($contents,$OUTFILE,$NAME) = @_;
	&open_tar_file($OUTFILE,$NAME,length($contents));
	print $OUTFILE $contents;
	$fixit = 512-(length($contents) % 512);
	print $OUTFILE pack("x$fixit",1) unless ($fixit == 512);
}
1;
# end of perltar.perl
			Mark Eichin
			<eichin@athena.mit.edu>
			MIT Student Information Processing Board