/* 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 this program.  If not, see <http://www.gnu.org/licenses/>. */

#include <stdio.h>
#include <string.h>
#include <fcntl.h>
#include <stdint.h>
#include <errno.h>
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif 

#ifdef HAVE_RPM_RPMIO_H
#include <rpm/rpmio.h>
#endif
#ifdef HAVE_RPM_RPMLIB_H
#include <rpm/rpmlib.h>
#endif

#ifdef HAVE_CAML_MLVALUES_H
#include <caml/mlvalues.h>
#endif
#ifdef HAVE_CAML_MEMORY_H
#include <caml/memory.h>
#endif
#ifdef HAVE_CAML_ALLOC_H
#include <caml/alloc.h>
#endif
#ifdef HAVE_CAML_CUSTOM_H
#include <caml/custom.h>
#endif

#ifdef DMALLOC
#include "dmalloc.h"
#endif

/* #define DEBUG */

#define NAPKIN_PK_UNIT						0
#define NAPKIN_PK_VERSION					1
#define NAPKIN_PK_ARCHITECTURE		2
#define NAPKIN_PK_EXTRA						3
#define NAPKIN_PK_SIZE						4
#define NAPKIN_PK_INSTALLED_SIZE	5
#define NAPKIN_PK_SOURCE					6
#define NAPKIN_PK_PROVIDES				7
#define NAPKIN_PK_CONFLICTS				8
#define NAPKIN_PK_BREAKS  				9
#define NAPKIN_PK_REPLACES				10
#define NAPKIN_PK_DEPENDS					11
#define NAPKIN_PK_PRE_DEPENDS			12
#define NAPKIN_PK_SUGGESTS				13
#define NAPKIN_PK_RECOMMENDS			14
#define NAPKIN_PK_ENHANCES				15
#define NAPKIN_PK_ESSENTIAL				16
#define NAPKIN_PK_BUILD_ESSENTIAL	17
#define NAPKIN_NR_FIELDS					18

/* Selectors */
#define SEL_LEQ 0
#define SEL_GEQ 1
#define SEL_LT	2
#define SEL_GT	3
#define SEL_EQ	4
#define SEL_ANY	(Val_int(0))

#define NAME_VERSION 0

const char *ocamlize_string (int32_t my_locale, int32_t nr_locales, int32_t type, const char *data)
{
	int32_t i;
	const char *ptr;
	switch (type)
	{
		case RPM_STRING_TYPE:
			return data;
		case RPM_I18NSTRING_TYPE:
			for (i = 0, ptr = data + (nr_locales * 4); i < my_locale; i++, ptr += strlen (ptr) + 1);
#ifdef DEBUG
			fprintf (stderr, "I18N string (locale %d): %s\n", my_locale, ptr);
#endif
			return ptr;
		default:
			fprintf (stderr, "ocamlize_string called for something that is not a string.\n");
			exit (EXIT_FAILURE);
	}
}

value ocamlize_rpm_dependency_list (char *pkgname, char *type, int length, char **names, char **versions, uint32_t *flags)
{
	int i;
	CAMLparam0 ();
	CAMLlocal5 (hd, tl, v0, v1, v2);
	tl = Val_int (0);	
	for (i = 0; i < length; i++)
	{
#ifdef DEBUG
    fprintf (stderr, "%s: %s[%d] is %s %s\n", pkgname, type, i, names[i], versions[i]);
#endif
		if (versions [i][0] == '%')
			fprintf (stderr, "[%s] Erroneous version found in %s: %s'%s\n", pkgname, type, names [i], versions [i]);
		if (strncmp (names [i], "rpmlib", 6) == 0)
			continue;
		switch (flags [i] % 16)
		{
			case 2: // < x
				v2 = caml_alloc (1, SEL_LT); 
				Store_field (v2, 0, caml_copy_string (versions [i]));
				break;
			case 4: // > x
				v2 = caml_alloc (1, SEL_GT); 
				Store_field (v2, 0, caml_copy_string (versions [i]));
				break;
			case 8: // = x
				v2 = caml_alloc (1, SEL_EQ); 
				Store_field (v2, 0, caml_copy_string (versions [i]));
				break;
			case 10: // <= x
				v2 = caml_alloc (1, SEL_LEQ); 
				Store_field (v2, 0, caml_copy_string (versions [i]));
				break;
			case 12: // >= x
				v2 = caml_alloc (1, SEL_GEQ); 
				Store_field (v2, 0, caml_copy_string (versions [i]));
				break;
			default: // any
				v2 = SEL_ANY;
		} 
		v1 = caml_alloc_tuple (2); // (name, versioned)
		Store_field (v1, 0, caml_copy_string (names [i]));
		Store_field (v1, 1, v2);
		v0 = caml_alloc (1, NAME_VERSION);
		Store_field (v0, 0, v1);
		hd = caml_alloc (2, 0); // selector list
		Store_field (hd, 0, v0);
		Store_field (hd, 1, tl);
		tl = hd;
	}
	CAMLreturn (tl);
}

/* Returns a pkg_metadata value */
value ocamlize_header (Header header, char *locale)
{
	HeaderIterator hi;
#if RPM_FORMAT_VERSION >= 5
	HE_t he = memset(alloca(sizeof(*he)), 0, sizeof(*he));
#else
	uint32_t tag, type, count;
	void *data;
#endif
	uint32_t epoch = 0, *dirindexes = NULL, nr_di = 0, nr_bn = 0, nr_dn = 0, nr_md5s = 0, nr_modes = 0, nr_p = 0, nr_d = 0, nr_c = 0, nr_o = 0, nr_s = 0, i;
  uint32_t *p_flags = NULL, *d_flags = NULL, *c_flags = NULL, *o_flags = NULL, *s_flags = NULL, nr_locales = 0, my_locale = 0;
	uint32_t installed_size, archive_size, date = 0;
	char *version = NULL, *release = NULL, **basenames = NULL, **dirnames = NULL, *version_string;
  char **p_names = NULL, **p_versions = NULL; 
  char **d_names = NULL, **d_versions = NULL;
  char **c_names = NULL, **c_versions = NULL;
  char **o_names = NULL, **o_versions = NULL;
  char **s_names = NULL, **s_versions = NULL;
  char **locales = NULL, *name = NULL, *pkgname = NULL, **md5s = NULL, *arch = NULL, *maintainer = NULL, *category = NULL, *source_package = NULL, *homepage = NULL, *summary = NULL, *description = NULL, *license = NULL, *distribution = NULL, *vendor = NULL, *os = NULL; 
	uint16_t *modes = NULL;
	CAMLparam0 ();
	CAMLlocal5 (napkin, v0, v1, v2, v3);
	CAMLlocal2 (hd, tl);
	CAMLlocal4 (depends_hd, depends_tl, pre_depends_hd, pre_depends_tl);
  CAMLlocal2 (suggests_hd, suggests_tl);
	napkin = caml_alloc (NAPKIN_NR_FIELDS, 0);
	
#if RPM_FORMAT_VERSION >= 5
# define TAG (he -> tag)
# define COUNT (he -> c)
# define TYPE (he -> t)
# define DATA(i) (he -> p.argv[i])
# define DATA_STR (he -> p.str)
# define UINT16(i) (he -> p.ui16p [i])
# define UINT32(i) (he -> p.ui32p [i])
#else
# define TAG (tag)
# define COUNT (count)
# define TYPE (type)
# define DATA(i) (((char **) data) [i])
# define DATA_STR ((char *) data)
# define RPM_UINT16_TYPE RPM_INT16_TYPE
# define RPM_UINT32_TYPE RPM_INT32_TYPE
#	define UINT16(i) (((uint16_t *) data) [i])
#	define UINT32(i) (((int32 *) data) [i])
#endif

#if RPM_FORMAT_VERSION >= 5
	hi = headerInit (header);
	while (headerNext (hi, he, 0))
#else
	hi = headerInitIterator (header);
	while (headerNextIterator (hi, &tag, &type, &data, &count))
#endif
	{
#ifdef DEBUG
		fprintf (stderr, "- tag number: %d\n", TAG);
#endif
		switch (TAG)
		{
			case HEADER_I18NTABLE:
				locales = (char **) malloc (COUNT * sizeof (char *));
				for (i = 0; i < COUNT; i++)
				{
					locales [i] = strdup (DATA (i));
					if (strcmp (locales [i], locale) == 0)
						my_locale = i;
				}
				nr_locales = COUNT;
				break;
			case RPMTAG_NAME: /* string type */
#ifdef DEBUG
				fprintf (stderr, "- Name: %s\n", DATA_STR);
#endif /* DEBUG */
				if (TYPE == RPM_STRING_TYPE)
					name = strdup (DATA_STR);
				else
					caml_failwith ("NAME tag without string type");	
				break;
			case RPMTAG_EPOCH:
				if (TYPE == RPM_UINT32_TYPE)
					epoch = UINT32(0);
				else
					caml_failwith ("EPOCH tag without int32 type");
				break;
			case RPMTAG_VERSION:
				if (TYPE == RPM_STRING_TYPE)
					version = strdup (DATA_STR);
				else
					caml_failwith ("VERSION tag without string type");
				break;
			case RPMTAG_RELEASE:
				if (TYPE == RPM_STRING_TYPE)
					release = strdup (DATA_STR);
				else
					caml_failwith ("RELEASE tag without string type");
				break;
			case RPMTAG_REQUIRENAME:
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					nr_d = COUNT;
					d_names = (char **) malloc (nr_d * sizeof (char *));
					for (i = 0; i < nr_d; i++)
						d_names [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("REQUIRENAME tag without string type");
				break;
			case RPMTAG_REQUIREVERSION:
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					if (nr_d == 0)
						nr_d = COUNT;	
					else if (COUNT != nr_d)
						caml_failwith ("The number of REQUIREVERSIONS is not consistent");
					d_versions = (char **) malloc (nr_d * sizeof (char *));
					for (i = 0; i < nr_d; i++)
						d_versions [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("REQUIREVERSION tag without string type");
				break;
			case RPMTAG_REQUIREFLAGS:
				if (TYPE == RPM_UINT32_TYPE)
				{
					if (nr_d == 0)
						nr_d = COUNT;	
					else if (COUNT != nr_d)
						caml_failwith ("The number of REQUIREFLAGS is not consistent");
					d_flags = (int32_t *) malloc (nr_d * sizeof (int32_t));
					for (i = 0; i < nr_d; i++)
						d_flags [i] = UINT32(i);
				}
				else
					caml_failwith ("REQUIREFLAGS tag without string type");
				break;
			case RPMTAG_PROVIDENAME:
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					nr_p = COUNT;
					p_names = (char **) malloc (nr_p * sizeof (char *));
					for (i = 0; i < nr_p; i++)
						p_names [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("PROVIDENAME tag without string type");
				break;
			case RPMTAG_PROVIDEVERSION:
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					if (nr_p == 0)
						nr_p = COUNT;	
					else if (COUNT != nr_p)
						caml_failwith ("The number of PROVIDEVERSIONS is not consistent");
					p_versions = (char **) malloc (nr_p * sizeof (char *));
					for (i = 0; i < nr_p; i++)
						p_versions [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("PROVIDEVERSION tag without string type");
				break;
			case RPMTAG_PROVIDEFLAGS:
				if (TYPE == RPM_UINT32_TYPE)
				{
					if (nr_p == 0)
						nr_p = COUNT;	
					else if (COUNT != nr_p)
						caml_failwith ("The number of PROVIDEFLAGS is not consistent");
					p_flags = (int32_t *) malloc (nr_p * sizeof (int32_t));
					for (i = 0; i < nr_p; i++)
						p_flags [i] = UINT32(i);
				}
				else
					caml_failwith ("PROVIDEFLAGS tag without string type");
				break;
			case RPMTAG_CONFLICTNAME:
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					nr_c = COUNT;
					c_names = (char **) malloc (nr_c * sizeof (char *));
					for (i = 0; i < nr_c; i++)
						c_names [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("CONFLICTNAME tag without string type");
				break;
			case RPMTAG_CONFLICTVERSION:
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					if (nr_c == 0)
						nr_c = COUNT;	
					else if (COUNT != nr_c)
						caml_failwith ("The number of CONFLICTVERSIONS is not consistent");
					c_versions = (char **) malloc (nr_c * sizeof (char *));
					for (i = 0; i < nr_c; i++)
						c_versions [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("CONFLICTVERSION tag without string type");
				break;
			case RPMTAG_CONFLICTFLAGS:
				if (TYPE == RPM_UINT32_TYPE)
				{
					if (nr_c == 0)
						nr_c = COUNT;	
					else if (COUNT != nr_c)
						caml_failwith ("The number of CONFLICTFLAGS is not consistent");
					c_flags = (int32_t *) malloc (nr_c * sizeof (int32_t));
					for (i = 0; i < nr_c; i++)
						c_flags [i] = UINT32(i);
				}
				else
					caml_failwith ("CONFLICTFLAGS tag without string type");
				break;
			case RPMTAG_OBSOLETENAME:
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					nr_o = COUNT;
					o_names = (char **) malloc (nr_o * sizeof (char *));
					for (i = 0; i < nr_o; i++)
						o_names [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("OBSOLETENAME tag without string type");
				break;
			case RPMTAG_OBSOLETEVERSION:
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					if (nr_o == 0)
						nr_o = COUNT;	
					else if (COUNT != nr_o)
						caml_failwith ("The number of OBSOLETEVERSIONS is not consistent");
					o_versions = (char **) malloc (nr_o * sizeof (char *));
					for (i = 0; i < nr_o; i++)
						o_versions [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("OBSOLETEVERSION tag without string type");
				break;
			case RPMTAG_OBSOLETEFLAGS:
				if (TYPE == RPM_UINT32_TYPE)
				{
					if (nr_o == 0)
						nr_o = COUNT;	
					else if (COUNT != nr_o)
						caml_failwith ("The number of OBSOLETEFLAGS is not consistent");
					o_flags = (int32_t *) malloc (nr_o * sizeof (int32_t));
					for (i = 0; i < nr_o; i++)
						o_flags [i] = UINT32(i);
				}
				else
					caml_failwith ("OBSOLETEFLAGS tag without string type");
				break;
			case RPMTAG_SUGGESTSNAME:
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					nr_s = COUNT;
					s_names = (char **) malloc (nr_s * sizeof (char *));
					for (i = 0; i < nr_s; i++)
						s_names [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("SUGGESTSNAME tag without string type");
				break;
			case RPMTAG_SUGGESTSVERSION:
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					if (nr_s == 0)
						nr_s = COUNT;	
					else if (COUNT != nr_s)
						caml_failwith ("The number of SUGGESTSVERSIONS is not consistent");
					s_versions = (char **) malloc (nr_s * sizeof (char *));
					for (i = 0; i < nr_s; i++)
						s_versions [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("SUGGESTSVERSION tag without string type");
				break;
			case RPMTAG_SUGGESTSFLAGS:
				if (TYPE == RPM_UINT32_TYPE)
				{
					if (nr_s == 0)
						nr_s = COUNT;	
					else if (COUNT != nr_s)
						caml_failwith ("The number of SUGGESTSFLAGS is not consistent");
					s_flags = (int32_t *) malloc (nr_s * sizeof (int32_t));
					for (i = 0; i < nr_s; i++)
						s_flags [i] = UINT32(i);
				}
				else
					caml_failwith ("SUGGESTSFLAGS tag without string type");
				break;
			case RPMTAG_ARCH: /* string type */
				if (TYPE == RPM_STRING_TYPE)
					arch = strdup (DATA_STR);
				else
					caml_failwith ("ARCHITECTURE tag without string type");	
				break;
			case RPMTAG_DIRINDEXES:
				nr_di = COUNT;
				if (TYPE == RPM_UINT32_TYPE)
				{
					dirindexes = (int32_t *) malloc (nr_di * sizeof (int32_t *));
					for (i = 0; i < nr_di; i++)
						dirindexes [i] = UINT32(i);
				}
				else
					caml_failwith ("DIRINDEXES tag without int32 type");
				break;
			case RPMTAG_BASENAMES:
				nr_bn = COUNT;
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					basenames = (char **) malloc (nr_bn * sizeof (char *));
					for (i = 0; i < nr_bn; i++)
						basenames [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("BASENAMES tag without string array type");
				break;
			case RPMTAG_DIRNAMES:
				nr_dn = COUNT;
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					dirnames = (char **) malloc (nr_dn * sizeof (char *));
					for (i = 0; i < nr_dn; i++)
						dirnames [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("BASENAMES tag without string array type");
				break;
			case RPMTAG_FILEMODES:
				nr_modes = COUNT;
				if (TYPE == RPM_UINT16_TYPE)
				{
					modes = (uint16_t *) malloc (nr_modes * sizeof (uint16_t));
					for (i = 0; i < nr_modes; i++)
						modes [i] = UINT16(i);
				}
				else
					caml_failwith ("MODES tag without uint16 type");
				break;
			case RPMTAG_FILEMD5S:
				nr_md5s = COUNT;
				if (TYPE == RPM_STRING_ARRAY_TYPE)
				{
					md5s = (char **) malloc (nr_md5s * sizeof (char *));
					for (i = 0; i < nr_md5s; i++)
						md5s [i] = strdup (DATA(i));
				}
				else
					caml_failwith ("FILEMD5S tag without string array tyoe");
				break;
			/* case RPMTAG_PACKAGER: // string type
				if ((TYPE == RPM_STRING_TYPE) || (TYPE == RPM_I18NSTRING_TYPE))
					maintainer = strdup (ocamlize_string (my_locale, nr_locales, TYPE, DATA_STR));
				else
					caml_failwith ("PACKAGER tag without (i18n) string type");	
				break;
			case RPMTAG_GROUP: // string type
				if ((TYPE == RPM_STRING_TYPE) || (TYPE == RPM_I18NSTRING_TYPE))
					category = strdup (ocamlize_string (my_locale, nr_locales, TYPE, DATA_STR));
				else
					caml_failwith ("GROUP tag without (i18n) string type");
				break; */
			case RPMTAG_ARCHIVESIZE: /* int32 type */
				if (TYPE == RPM_UINT32_TYPE)
					archive_size = UINT32(0);
				else
					caml_failwith ("ARCHIVE_SIZE tag without int32 type");
				break;
			case RPMTAG_SIZE: /* int32 type */
				if (TYPE == RPM_UINT32_TYPE)
					installed_size = UINT32(0);
				else
					caml_failwith ("SIZE tag without int32 type");
				break;
			case RPMTAG_SOURCERPM: /* string type */
#ifdef DEBUG
				fprintf (stderr, "- Source RPM: %s\n", DATA_STR);
#endif
				if (TYPE == RPM_STRING_TYPE)
					source_package = strdup (DATA_STR);
				else
					caml_failwith ("SOURCERPM tag without string type");
				break;
			/* case RPMTAG_URL: // string type
				if ((TYPE == RPM_STRING_TYPE) || (TYPE == RPM_I18NSTRING_TYPE))
					homepage = strdup (ocamlize_string (my_locale, nr_locales, TYPE, DATA_STR));
				else
					caml_failwith ("URL tag without (i18n) string type");
				break;
			case RPMTAG_SUMMARY: // string type
				if ((TYPE == RPM_STRING_TYPE) || (TYPE == RPM_I18NSTRING_TYPE))
					summary = strdup (ocamlize_string (my_locale, nr_locales, TYPE, DATA_STR));
				else
					caml_failwith ("SUMMARY tag without (i18n) string type");
				break;
			case RPMTAG_DESCRIPTION: // string type
				if ((TYPE == RPM_STRING_TYPE) || (TYPE == RPM_I18NSTRING_TYPE))
					description = strdup (ocamlize_string (my_locale, nr_locales, TYPE, DATA_STR));
				else
					caml_failwith ("DESCRIPTION tag without (i18n) string type");
				break;
			case RPMTAG_LICENSE:
#ifdef DEBUG
				fprintf (stderr, "- License: %s\n", DATA_STR);
#endif
				if (TYPE == RPM_STRING_TYPE)
					license = strdup (DATA_STR);
				else
					caml_failwith ("LICENSE tag without string type");
				break;
			case RPMTAG_DISTRIBUTION:
#ifdef DEBUG
				fprintf (stderr, "- Distribution: %s\n", DATA_STR);
#endif
				if (TYPE == RPM_STRING_TYPE)
					distribution = strdup (DATA_STR);
				else
					caml_failwith ("DISTRIBUTION tag without string type");
				break;
			case RPMTAG_VENDOR:
				if ((TYPE == RPM_STRING_TYPE) || (TYPE == RPM_I18NSTRING_TYPE))
					vendor = strdup (ocamlize_string (my_locale, nr_locales, TYPE, DATA_STR));
				else
					caml_failwith ("VENDOR tag without (i18n) string type");
				break;
			case RPMTAG_OS:
				if (TYPE == RPM_STRING_TYPE)
					os = strdup (DATA_STR);
				else
					caml_failwith ("OS tag without string type");
				break;
			case RPMTAG_BUILDTIME:
				if (TYPE == RPM_UINT32_TYPE)
					date = UINT32(0);
				else
					caml_failwith ("BUILDTIME tag without int32 type");
				break; */
		}
#if RPM_FORMAT_VERSION >= 5
		free (he -> p.ptr);
#endif
	}
#if RPM_FORMAT_VERSION >= 5
	headerFini(hi);
#else
	headerFreeIterator (hi);
#endif
	for (i = 0; i < nr_locales; i++)
		free (locales [i]);
	free (locales);
#ifdef DEBUG
	fprintf (stderr, "- finished with header.\n");
#endif
	/* name (pk_unit) */
	if (name == NULL)
		caml_failwith ("No NAME tag found");
	else
		Store_field (napkin, NAPKIN_PK_UNIT, caml_copy_string (name));
	/* version */
	if (epoch == 0)
		version_string = strdup ("");
	else
		asprintf (&version_string, "%d:", epoch);
	if (version != NULL)
	{
		version_string = (char *) realloc (version_string, strlen (version_string) + strlen (version) + 1);
		strcat (version_string, version);
	}
	if (release != NULL)
	{
		version_string = (char *) realloc (version_string, strlen (version_string) + strlen (release) + 2);
    strcat (version_string, "-");
    strcat (version_string, release);
  }
  Store_field (napkin, NAPKIN_PK_VERSION, caml_copy_string (version_string));
	free (version); free (release);
	asprintf (&pkgname, "%s'%s", name, version_string);
	/* architecture */
	if (arch == NULL)
		Store_field (napkin, NAPKIN_PK_ARCHITECTURE, caml_copy_string (""));
	else
		Store_field (napkin, NAPKIN_PK_ARCHITECTURE, caml_copy_string (arch));
	free (arch);
	/* extra */
	Store_field (napkin, NAPKIN_PK_EXTRA, Val_unit);
	/* size */
	Store_field (napkin, NAPKIN_PK_SIZE, caml_copy_int64 (archive_size));
	/* installed_size */
	Store_field (napkin, NAPKIN_PK_INSTALLED_SIZE, caml_copy_int64 (installed_size));
	/* source */
	v0 = caml_alloc_tuple (2);
	if (source_package == NULL)
	{	
		Store_field (v0, 0, caml_copy_string (name));
		Store_field (v0, 1, caml_copy_string (version_string));
	}
	else
	{
		char *last_dash = strrchr (source_package, '-'), *sep, *dot;
		if (last_dash != NULL)
		{
			dot = strchr (last_dash + 1, '.');
			if (dot != NULL)
				*dot = '\0';
			*last_dash = '\0';
			sep = strrchr (source_package, '-');
			if (sep != NULL)
			{
				*last_dash = '-';
				*sep = '\0';
				Store_field (v0, 0, caml_copy_string (source_package));
				Store_field (v0, 1, caml_copy_string (sep + 1));
			}
			else
			{
				Store_field (v0, 0, caml_copy_string (source_package));
				Store_field (v0, 1, caml_copy_string (last_dash + 1));
			}
		}
		else
		{
			Store_field (v0, 0, caml_copy_string (source_package));
			Store_field (v0, 1, caml_copy_string (version_string));
		}
	}
	Store_field (napkin, NAPKIN_PK_SOURCE, v0);
	free (source_package); free (version_string); free (name);
	/* provides */
	v0 = ocamlize_rpm_dependency_list (pkgname, "provides", nr_p, p_names, p_versions, p_flags); 
	Store_field (napkin, NAPKIN_PK_PROVIDES, v0);
	for (i = 0; i < nr_p; i++)
	{
		free (p_names [i]); free (p_versions [i]);
	}
	free (p_names); free (p_versions); free (p_flags);
	/* conflicts */
	v0 = ocamlize_rpm_dependency_list (pkgname, "conflicts", nr_c, c_names, c_versions, c_flags); 
	Store_field (napkin, NAPKIN_PK_CONFLICTS, v0);
	for (i = 0; i < nr_c; i++)
	{
		free (c_names [i]); free (c_versions [i]);
	}
	if (c_names != NULL)
	{
		free (c_names); free (c_versions); free (c_flags);
	}
	/* replaces */
	v0 = ocamlize_rpm_dependency_list (pkgname, "obsoletes", nr_o, o_names, o_versions, o_flags); 
	Store_field (napkin, NAPKIN_PK_REPLACES, v0);
	for (i = 0; i < nr_o; i++)
	{
		free (o_names [i]); free (o_versions [i]);
	}
	if (o_names != NULL)
	{
		free (o_names); free (o_versions); free (o_flags);
	}
	/* depends */
	/* special case: both flags-wise and list-creation-wise */
	depends_tl = Val_int (0);	
	pre_depends_tl = Val_int (0);	
	for (i = 0; i < nr_d; i++)
	{
		if (d_versions [i][0] == '%')
			fprintf (stderr, "Warning: [%s] depends on erroneous version: %s'%s\n", pkgname, d_names [i], d_versions [i]);
		if (strncmp (d_names [i], "rpmlib", 6) == 0)
			continue;
		switch (d_flags [i] % 16)
		{
			case 2: // < x
				v3 = caml_alloc (1, SEL_LT); 
				Store_field (v3, 0, caml_copy_string (d_versions [i]));
				break;
			case 4: // > x
				v3 = caml_alloc (1, SEL_GT); 
				Store_field (v3, 0, caml_copy_string (d_versions [i]));
				break;
			case 8: // = x
				v3 = caml_alloc (1, SEL_EQ); 
				Store_field (v3, 0, caml_copy_string (d_versions [i]));
				break;
			case 10: // <= x
				v3 = caml_alloc (1, SEL_LEQ); 
				Store_field (v3, 0, caml_copy_string (d_versions [i]));
				break;
			case 12: // >= x
				v3 = caml_alloc (1, SEL_GEQ); 
				Store_field (v3, 0, caml_copy_string (d_versions [i]));
				break;
			default: // any
				v3 = SEL_ANY;
		} 
		v2 = caml_alloc_tuple (2); // (name, versioned)
		Store_field (v2, 0, caml_copy_string (d_names [i]));
		Store_field (v2, 1, v3);
		v1 = caml_alloc (1, NAME_VERSION); // instead of glob_pattern
		Store_field (v1, 0, v2);
		v0 = caml_alloc (2, 0);
		Store_field (v0, 0, v1);
		Store_field (v0, 1, Val_int (0));
		if (d_flags [i] & (1<<9)) // it's a pre_dependency
		{
			pre_depends_hd = caml_alloc (2, 0); // versioned list
			Store_field (pre_depends_hd, 0, v0);
			Store_field (pre_depends_hd, 1, pre_depends_tl);
			pre_depends_tl = pre_depends_hd;
		}
		else
		{
			depends_hd = caml_alloc (2, 0); // versioned list
			Store_field (depends_hd, 0, v0);
			Store_field (depends_hd, 1, depends_tl);
			depends_tl = depends_hd;
		}
	}
	Store_field (napkin, NAPKIN_PK_DEPENDS, depends_tl);
	Store_field (napkin, NAPKIN_PK_PRE_DEPENDS, pre_depends_tl);
	for (i = 0; i < nr_d; i++)
	{
		free (d_names [i]); free (d_versions [i]);
	}
	free (d_names); free (d_versions); free (d_flags);
	/* suggests, like depends */
	suggests_tl = Val_int (0);	
	for (i = 0; i < nr_s; i++)
	{
		if (s_versions [i][0] == '%')
			fprintf (stderr, "Warning: [%s] suggests erroneous version: %s'%s\n", pkgname, s_names [i], s_versions [i]);
		if (strncmp (s_names [i], "rpmlib", 6) == 0)
			continue;
		switch (s_flags [i] % 16)
		{
			case 2: // < x
				v3 = caml_alloc (1, SEL_LT); 
				Store_field (v3, 0, caml_copy_string (s_versions [i]));
				break;
			case 4: // > x
				v3 = caml_alloc (1, SEL_GT); 
				Store_field (v3, 0, caml_copy_string (s_versions [i]));
				break;
			case 8: // = x
				v3 = caml_alloc (1, SEL_EQ); 
				Store_field (v3, 0, caml_copy_string (s_versions [i]));
				break;
			case 10: // <= x
				v3 = caml_alloc (1, SEL_LEQ); 
				Store_field (v3, 0, caml_copy_string (s_versions [i]));
				break;
			case 12: // >= x
				v3 = caml_alloc (1, SEL_GEQ); 
				Store_field (v3, 0, caml_copy_string (s_versions [i]));
				break;
			default: // any
				v3 = SEL_ANY;
		} 
		v2 = caml_alloc_tuple (2); // (name, versioned)
		Store_field (v2, 0, caml_copy_string (s_names [i]));
		Store_field (v2, 1, v3);
		v1 = caml_alloc (1, NAME_VERSION); // instead of glob_pattern
		Store_field (v1, 0, v2);
		v0 = caml_alloc (2, 0);
		Store_field (v0, 0, v1);
		Store_field (v0, 1, Val_int (0));
		suggests_hd = caml_alloc (2, 0); // versioned list
		Store_field (suggests_hd, 0, v0);
		Store_field (suggests_hd, 1, suggests_tl);
		suggests_tl = suggests_hd;
	}
	Store_field (napkin, NAPKIN_PK_SUGGESTS, suggests_tl);
	for (i = 0; i < nr_s; i++)
	{
		free (s_names [i]); free (s_versions [i]);
	}
	free (s_names); free (s_versions); free (s_flags);
	/* RPM doesn't know suggests, recommends, enhances, essential and/or
	 * build-essential */
  Store_field (napkin, NAPKIN_PK_BREAKS, Val_int (0));
	Store_field (napkin, NAPKIN_PK_RECOMMENDS, Val_int (0));
	Store_field (napkin, NAPKIN_PK_ENHANCES, Val_int (0));
	Store_field (napkin, NAPKIN_PK_ESSENTIAL, Val_int (0));
	Store_field (napkin, NAPKIN_PK_BUILD_ESSENTIAL, Val_int (0));
	/* files */
	if ((nr_bn != nr_md5s) && (nr_md5s > 0))
	{
		caml_failwith ("The number of basenames is not equal to the number of MD5 keys");
	}
	if ((nr_bn != nr_modes) && (nr_modes > 0))
	{
		caml_failwith ("The number of basenames is not equal to the number of file mode entries");
	}
	tl = Val_int (0);
	for (i = 0; i < nr_bn; i++)
	{
		char *t;
		if (modes [i] & 040000 == 040000)
    	asprintf (&t, "%s%s/", dirnames [dirindexes [i]], basenames [i]);
		else
    	asprintf (&t, "%s%s", dirnames [dirindexes [i]], basenames [i]);
#ifdef DEBUG
    fprintf (stderr, "file[%d]: %s\n", i, t);
#endif
    v0 = caml_alloc (2, 0);
    Store_field (v0, 0, caml_copy_string (t));
    Store_field (v0, 1, caml_copy_string (nr_md5s == 0 ? "" : md5s [i]));
		hd = caml_alloc (2, 0);
		Store_field (hd, 0, v0);
		Store_field (hd, 1, tl);
    free (t);
    tl = hd;
  }
  Store_field (napkin, NAPKIN_PK_EXTRA, tl);
  for (i = 0; i < nr_bn; i++)
    free (basenames [i]);
  for (i = 0; i < nr_dn; i++)
    free (dirnames [i]);
  for (i = 0; i < nr_md5s; i++)
    free (md5s [i]);
	if (basenames != NULL)
  	free (basenames);
	if (dirnames != NULL)
		free (dirnames);
	if (dirindexes != NULL)
		free (dirindexes);
	if (md5s != NULL)
		free (md5s);
	free (pkgname);
	CAMLreturn (napkin);
}

value ocamlrpm_read_package (value locale, value file_name)
{
	FD_t fd;
	Header header;
#if RPM_FORMAT_VERSION < 5 && defined(HAVE_RPMLEAD)
	struct rpmlead lead;
#endif
	CAMLparam2 (locale, file_name);
	CAMLlocal1 (retval);

	fd = Fopen (String_val (file_name), "r");
	if (!fd)
		caml_failwith (strerror (errno));

#if RPM_FORMAT_VERSION < 5 && defined(HAVE_RPMLEAD)
	readLead (fd, &lead);
	rpmReadSignature (fd, NULL, lead.signature_type);
	header = headerRead (fd, lead.major >= 3 ? HEADER_MAGIC_YES : HEADER_MAGIC_NO);
#endif
	retval = ocamlize_header (header, String_val (locale));	
	Fclose (fd);
	CAMLreturn (retval);
}

value ocamlrpm_read_hdlist (value locale, value file_name)
{
	uint32_t block[4], il, dl, *ei, nb;
	ssize_t x;
	FD_t fd;
	Header header;
	CAMLparam2 (locale, file_name);
	CAMLlocal2 (hd, tl);

	fd = Fopen (String_val (file_name), "r");
	if (!fd)
		caml_failwith (strerror (errno));
#if RPM_FORMAT_VERSION >= 5
  x = ufdio->read (fd, (char *) block, sizeof (block));
	if (x == 0)
		CAMLreturn (Val_int (0));
	else if (x != sizeof (block))
	{
		char *s;
		asprintf (&s, "Read %u bytes (%u expected)", x, sizeof (block)); 
		caml_failwith (s);
	}
	il = ntohl (block [2]);
	dl = ntohl (block [3]);
	nb = (il * 16) + dl;
	ei = (uint32_t *) malloc (sizeof (il) + sizeof (dl) + nb);
	if ((x = ufdio->read (fd, (char *) &ei [2], nb)) != nb)
	{
		char *s;
		asprintf (&s, "Read %u bytes (%u expected)", x, nb);
		caml_failwith (s);
	}
	ei [0] = block [2];
	ei [1] = block [3];
	header = headerLoad (ei);
#else
	header = headerRead (fd, HEADER_MAGIC_YES);
#endif /* RPM_FORMAT_VERSION */
	tl = Val_int (0);
	while (header != NULL)
	{
		hd = caml_alloc (2, 0);
		Store_field (hd, 0, ocamlize_header (header, String_val (locale)));
		Store_field (hd, 1, tl);
		headerFree (header);
		header = NULL;
#if RPM_FORMAT_VERSION >= 5
		free (ei);
		ei = NULL;
  	x = ufdio->read (fd, (char *) block, sizeof (block));
		if (x == 0)
			break;
		else if (x != sizeof (block))
		{
			char *s;
			asprintf (&s, "Read %u bytes (%u expected)", x, sizeof (block)); 
			caml_failwith (s);
		}
		il = ntohl (block [2]);
		dl = ntohl (block [3]);
		nb = (il * 16) + dl;
		ei = (uint32_t *) xmalloc (sizeof (il) + sizeof (dl) + nb);
		if ((x = ufdio->read (fd, (char *) &ei [2], nb)) != nb)
		{
			char *s;
			asprintf (&s, "Read %u bytes (%u expected)", x, nb);
			caml_failwith (s);
		}
		ei [0] = block [2];
		ei [1] = block [3];
		header = headerLoad (ei);
#else
		header = headerRead (fd, HEADER_MAGIC_YES);
#endif /* RPM_FORMAT_VERSION */
		tl = hd;
	}
	if (header != NULL)
		headerFree (header);
#if RPM_FORMAT_VERSION >= 5
	free (ei);
#endif /* RPM_FORMAT_VERSION */
	Fclose (fd);
	CAMLreturn (tl);
}
