;;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; -*-
;;;
;;;   Touched: Wed Feb 22 00:22:51 2006 -0700 <enometh@net.meer>
;;;   Time-stamp: <2006-02-24 00:16:32 madhu>
;;;
(in-package :CL-USER)
(eval-when (:compile-toplevel)
  (unless (find-package "BINARY-TYPES")
    (or #+cmu
	(lc "home:cmu/binary-types-0.90/binary-types.lisp")
	(error "Requires frodef's excellent BINARY-TYPES package."))))

(defpackage "TAR-IMPL" (:use "CL" "BINARY-TYPES"))
(in-package "TAR-IMPL")

;;; Extended tar format from POSIX.1.
;;; Following Text is taken from /usr/include/tar.h
;;;

#||A tar archive consists of 512-byte blocks.
   Each file in the archive has a header block followed by 0+ data blocks.
   Two blocks of NUL bytes indicate the end of the archive.

   The fields of header blocks:
   All strings are stored as ISO 646 (approximately ASCII) strings.

   Fields are numeric unless otherwise noted below; numbers are ISO 646
   representations of octal numbers, with leading zeros as needed.

   linkname is only valid when typeflag==LNKTYPE.  It doesn't use prefix;
   files that are links to pathnames >100 chars long can not be stored
   in a tar archive.

   If typeflag=={LNKTYPE,SYMTYPE,DIRTYPE} then size must be 0.

   devmajor and devminor are only valid for typeflag=={BLKTYPE,CHRTYPE}.

   chksum contains the sum of all 512 bytes in the header block,
   treating each byte as an 8-bit unsigned value and treating the
   8 bytes of chksum as blank characters.

   uname and gname are used in preference to uid and gid, if those
   names exist locally.

   Field Name	Byte Offset	Length in Bytes	Field Type
||#

(defvar $header-entries
 '((name	0		100);		NUL-terminated if NUL fits
  (mode		100		8)
  (uid		108		8)
  (gid		116		8)
  (size		124		12)
  (mtime	136		12)
  (chksum	148		8)
  (typeflag	156		1	)	;see below
  (linkname	157		100	)	;NUL-terminated if NUL fits
  (magic	257		6	)	;must be TMAGIC (NUL term.)
  (version	263		2	)	;must be TVERSION
  (uname	265		32	)	;NUL-terminated
  (gname	297		32	);	NUL-terminated
  (devmajor	329		8)
  (devminor	337		8)
  (prefix	345		155)));		NUL-terminated if NUL fits

(defmacro define-tar-header ()
  `(define-binary-class tar-header ()
    ,(loop for (field-name byte-offset length-in-bytes) in $header-entries
	     collect (list field-name :binary-type 
			   (list 'define-null-terminated-string field-name 
			     length-in-bytes)))))

(define-tar-header)


(defun round-to-nearest-block (size)
  (multiple-value-bind (quo rem) (floor size 512)
    (if (zerop rem) size (* 512 quo))))

#+nil
(inspect 
 (with-open-file (stream #p"/tmp/binary-types-0.90.tar" :element-type
 '(unsigned-byte 8)) (read-binary 'tar-header  stream)))