(* Copyright 2005-2008 Jaap BOENDER.

This file is part of Dose2.

Dose2 is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.

Dose2 is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License
along with Dose2; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
*)

open Big_int
open Util

type ar_header =
{
	file_name: string;
	file_time: big_int;
	file_uid: int;
	file_gid: int;
	file_mode: int;
	file_size: big_int
}

type tar_header =
{
	ar_header: ar_header
}

(**
Arrrr! Deal with ar(1) files
@author Jaap Boender
*)

(**
Read the global header
@param ar_channel Channel to read from
@raise Failure if the header is not present
*)
let read_ar_global_header (ar_channel: in_channel): unit =
let magic = String.create 8 in
begin
	ignore (input ar_channel (magic) 0 8);
	if magic <> "!<arch>\n" then
		raise (Failure "This is not an ar(1) archive")
end;;

(**
Read the header
@param ar_channel Channel to read from
@return a list of file name, date, uid, gid, mode, size
@raise End_of_file if end of archive is reached
*)
let read_ar_header (ar_channel: in_channel): ar_header =
let name = String.create 16
and date = String.create 12
and uid = String.create 6
and gid = String.create 6
and mode = String.create 8
and size = String.create 10
and magic = String.create 2 in
begin
	if input ar_channel name 0 16 = 0 then
		raise End_of_file;
	ignore (input ar_channel date 0 12); 
	ignore (input ar_channel uid 0 6);
	ignore (input ar_channel gid 0 6);
	ignore (input ar_channel mode 0 8);
	ignore (input ar_channel size 0 10);
	ignore (input ar_channel magic 0 2);
	if magic <> "`\n" then
		raise (Failure "Error in magic number in ar(1) header");
	{ file_name = name;
		file_time = big_int_of_string date;
		file_uid = int_of_string (remove_leading_spaces uid);
		file_gid = int_of_string (remove_leading_spaces gid);
		file_mode = int_of_string (remove_leading_spaces mode);
		file_size = big_int_of_string size }
end;;

(**
Seek to a particular file 
@param ar_channel The channel to read from
@param header Information from the header
@return size of file according to header
@raise Failure if file is not found in archive
*)
let ar_seek_to_file (ar_channel: in_channel) (filename: string): big_int = 
let my_name = ref "" 
and my_size = ref zero_big_int in
begin
	while !my_name <> filename
	do
		let header =
			try
				read_ar_header ar_channel 
			with End_of_file -> raise (Failure "File was not found in archive") in
		my_name := remove_leading_spaces header.file_name;
		my_size := header.file_size;
		if !my_name <> filename then
		let isize = int_of_big_int header.file_size in
			seek_in ar_channel ((pos_in ar_channel) + if isize mod 2 = 0 then isize else isize + 1)
	done;
	!my_size
end;;

(**
Open an AR file for reading and seek to the first file
@param filename File name
@return a channel
*)
let open_ar_file (filename: string): in_channel =
let ar_channel = open_in_bin filename in
begin
	read_ar_global_header ar_channel;
	ar_channel
end;;

(**
Read a tar header from a (binary) channel
@param channel Channel to read from
@param input_function Function that inputs from the channel
@return the tar header
*)
let read_tar_header (channel: 'a) (input_function: 'a -> string -> int -> int -> int): tar_header =
let file_name = String.create 100 
and file_mode = String.create 8
and file_uid = String.create 8
and file_gid = String.create 8
and file_size = String.create 12
and file_time = String.create 12 
and checksum = String.create 8
and link_indicator = String.create 1
and link_name = String.create 100
and ustar = String.create 6
and ustar_version = String.create 2 
and user_name = String.create 32
and group_name = String.create 32 
and dev_major = String.create 8
and dev_minor = String.create 8
and file_prefix = String.create 155 
and padding = String.create 12 in
begin
	ignore (input_function channel file_name 0 100);
	ignore (input_function channel file_mode 0 8);
	ignore (input_function channel file_uid 0 8);
	ignore (input_function channel file_gid 0 8);
	ignore (input_function channel file_size 0 12);
	ignore (input_function channel file_time 0 12);
	ignore (input_function channel checksum 0 8);
	ignore (input_function channel link_indicator 0 1);
	ignore (input_function channel link_name 0 100);
	ignore (input_function channel ustar 0 6);
	ignore (input_function channel ustar_version 0 2);
	ignore (input_function channel user_name 0 32);
	ignore (input_function channel group_name 0 32);
	ignore (input_function channel dev_major 0 8);
	ignore (input_function channel dev_minor 0 8);
	ignore (input_function channel file_prefix 0 155);
	ignore (input_function channel padding 0 12);
	{ ar_header =
		{ file_name = file_name;
			file_time = big_int_of_string (remove_leading_spaces file_time);
			file_uid = int_of_string (remove_leading_spaces file_uid);
			file_gid = int_of_string (remove_leading_spaces file_gid);
			file_mode = int_of_string (remove_leading_spaces file_mode);
			(* XXX only works for ints! *)
			file_size = big_int_of_int (int_of_string ("0o" ^ (remove_leading_spaces file_size)))
		}
	}
end;;

(**
Seek to a particular file in a TAR archive
@param channel Channel to read from
@param input_function Function that inputs from the channel
@param input_char_function Function that reads one character from the channel
@param filename File to seek to
@return the size of the file
*)
let tar_seek_to_file (channel: 'a) (input_function: 'a -> string -> int -> int -> int) (input_char_function: 'a -> char) (filename: string): big_int = 
let my_name = ref "" 
and my_size = ref zero_big_int in
begin
	while !my_name <> filename
	do
		let header =
			try
				read_tar_header channel input_function
			with End_of_file -> raise (Failure "File was not found in archive") in
		my_name := remove_leading_spaces header.ar_header.file_name;
		my_size := header.ar_header.file_size;
		if !my_name <> filename then
		let isize = int_of_big_int header.ar_header.file_size in
		let iblocks = if isize = 0 then 0 else isize / 512 + 1 in
		for i = 1 to 512 * iblocks do ignore (input_char_function channel) done
	done;
	!my_size
end;;
