#!/usr/bin/perl
# pristine-tar file format parsing

package Pristine::Tar::Formats;

use warnings;
use strict;
use Exporter q{import};
our @EXPORT=qw{is_gz is_bz2 is_xz %fconstants};

our %fconstants=(
	# magic identification
	GZIP_ID1 => 0x1F,
	GZIP_ID2 => 0x8B,
	BZIP2_ID1 => 0x42,
	BZIP2_ID2 => 0x5a,
	XZ_ID1 => 0xFD,
	XZ_ID2 => 0x37,
	XZ_ID3 => 0x7A,
	XZ_ID4 => 0x58,
	XZ_ID5 => 0x5A,
	XZ_ID6 => 0x00,

	# compression methods
	# 0x00-0x07 are reserved
	GZIP_METHOD_DEFLATE => 0x08,
	# 'h' for Bzip2 ('H'uffman coding)
	BZIP2_METHOD_HUFFMAN => 0x68,

	# flags
	GZIP_FLAG_FTEXT => 0,
	GZIP_FLAG_FHCRC => 1,
	GZIP_FLAG_FEXTRA => 2,
	GZIP_FLAG_FNAME => 3,
	GZIP_FLAG_FCOMMENT => 4,
	# the rest are reserved

	# compression level
	GZIP_COMPRESSION_NORMAL => 0,
	GZIP_COMPRESSION_BEST => 2,
	GZIP_COMPRESSION_FAST => 4,

	# operating systems
	GZIP_OS_MSDOS => 0,
	GZIP_OS_AMIGA => 1,
	GZIP_OS_VMS => 2,
	GZIP_OS_UNIX => 3,
	GZIP_OS_VMCMS => 4,
	GZIP_OS_ATARI => 5,
	GZIP_OS_HPFS => 6,
	GZIP_OS_MACINTOSH => 7,
	GZIP_OS_ZSYSTEM => 8,
	GZIP_OS_CPM => 9,
	GZIP_OS_TOPS => 10,
	GZIP_OS_NTFS => 11,
	GZIP_OS_QDOS => 12,
	GZIP_OS_RISCOS => 13,
	GZIP_OS_VFAT => 14,
	GZIP_OS_UNKNOWN => 255,
);

sub magic {
	my $file=shift;

	open (my $in, "<", $file) || die "$file: $!";
	my $count=$#_+1;
	my ($chars, @bits);
	my $ret = (
		read($in, $chars, $count) == $count &&
		(@bits = unpack(("C" x $count), $chars)) &&
		(! grep { $bits[$_] != $_[$_] } (0..$count-1))
    	);
	close $in;
	return $ret;
}

sub is_gz {
	magic(shift, $fconstants{GZIP_ID1}, $fconstants{GZIP_ID2},
		$fconstants{GZIP_METHOD_DEFLATE});
}

sub is_bz2 {
	magic(shift, $fconstants{BZIP2_ID1}, $fconstants{BZIP2_ID2},
		$fconstants{BZIP2_METHOD_HUFFMAN});
}

sub is_xz {
	magic(shift, $fconstants{XZ_ID1}, $fconstants{XZ_ID2},
		$fconstants{XZ_ID3}, $fconstants{XZ_ID4},
		$fconstants{XZ_ID5}, $fconstants{XZ_ID6});
}

1