/*
 * ratDbase.c --
 *
 * TkRat software and its included text is Copyright 1996,1997,1998
 * by Martin Forssn
 *
 * Postilion software and its included text and images
 * Copyright (C) 1998 Nic Bernstein
 *
 * The full text of the legal notices is contained in the files called
 * COPYING and COPYRIGHT.TkRat, included with this distribution.
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 * 
 * This program 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 General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
 */

/*
 *	This file contains support for a database of messages. This file
 *	uses version 3 of the database. The format of the database is as
 *	follows:
 *
 *	The database directory contains the following entries:
 *	  index		The main database index. This file consists
 *			of a number of entries separated by newline and
 *			each entry has the following format:
 *				To
 *				From
 *				Cc
 *				Subject
 *				Date (UNIX time_t as a string)
 *				Keywords (SPACE separated list)
 *				Size
 *				Status
 *				Expiration time (UNIX time_t as a string)
 *				Expiration event (*)
 *				Filename
 *			Expiration event is one of none, remove, incoming,
 *			backup and custom. Custom is followed by the custom
 *			command.
 *	  index.info	This file contains information about the database.
 *			It contains two integers. The first is the version
 *			(in this case 3) and the second is the number of
 *			entries in the indexfile.
 *	  index.changes	This file contains a log of changes made to the
 *			index file. This log is only kept if the multiple
 *			agents has opened the database. In this file each
 *			entry is one line. There are addition entries;
 *			'a OFFSET' where OFFSET is the position in the
 *			index file where this entry starts. There are also
 *			deletion entries; 'd INDEX'. Finally there are
 *			the status changes; they are of the form:
 *			's INDEX STATUS' where STATUS is the new status of
 *			the specified message.
 *	  lock		If this file exists the database is locked and
 *			no other agent may do anything with it. It should
 *			contain a string identifying the agent owning the
 *			lock.
 *	  rlock.*	Each agent that opens the database should construct
 *			a file with the following name: rlock.HOST:PID .
 *			This file should be touched at least once every
 *			hour.
 *	  dbase/	This is a directory which holds a number of
 *			directories which in turn holds the actual messages.
 *
 *	In the dbase directory messages are stored as recipient-name/number.
 *	Where the last number taken in a recipient-name directory is
 *	contained in a .seq file found in said directory.
 */

#include "ratFolder.h"

#define DBASE_VERSION 3		/* Version of the database format */
#define EXTRA_ENTRIES 100	/* How many extra entries we should allocate
				 * room for when allocating the entryPtr
				 * array */
#define RLOCK_TIMEOUT 2*60*60	/* Actual timeout time for rlock files */
#define UPDATE_INTERVAL 40*60	/* Time between updates to the rlock file */

static int isRead = 0;		/* 0 means that the database hasn't been
				 * read yet */
static int numRead;		/* The number of entries in the entryPtr list */
static int numAlloc;		/* The number of entries that will fit
				 * into the entryPtr list */
static RatDbEntry *entryPtr;	/* The list of entries in the database */
static char *dbDir = 0;		/* Full path to the database directory */
static char *ident = 0; 	/* String which is used to identify us.
				 * It is of the form hostname:pid */
static int changeSize = 0;	/* The number of bytes in the index.changes
				 * file that we have read and incorporated
				 * into our memory resident database */
static int numChanges = 0;	/* Number of changes in the changes file */

/*
 * This structure is used while checking the dbase
 */
typedef struct {
    int fileSize;	/* The actual size of the file */
    int index;		/* Index in the list that handles this entry */
    RatDbEntry entry;	/* The actual entry in the index file */
} RatDbItem;

/*
 * Forward declarations for procedures defined in this file:
 */
static int	Read(Tcl_Interp *interp);
static void	Lock(Tcl_Interp *interp);
static void	Unlock(Tcl_Interp *interp);
static int	Sync(Tcl_Interp *interp);
static void	Update(ClientData clientData);
static int	IsRlocked(char *ignore);
static void	RatDbBuildList(Tcl_Interp *interp, Tcl_DString *dsPtr,
	char *prefix, char *dir, Tcl_HashTable *tablePtr, int fix);
static int	NoLFPrint(FILE *fp, char *s);



/*
 *----------------------------------------------------------------------
 *
 * Read --
 *
 *      Reads the database from disk into memory.
 *
 * Results:
 *      The return value is normally TCL_OK; if something goes wrong
 *	TCL_ERROR is returned and an error message will be left in
 *	interp->result.
 *
 * Side effects:
 *      The internal list of entries is allocated and initalized. An
 *	rlock-file is created to indicate that we have the database
 *	open. To keep this lock up to date the Update() procedure must
 *	be called at least once every hour. When the agent won't access
 *	the database anymore it must be closed with a call to RatDbClose().
 *
 *
 *----------------------------------------------------------------------
 */

static int
Read(Tcl_Interp *interp)
{
    char buf[1024];	/* Scratch area */
    int size;		/* Size of indexfile */
    struct stat sbuf;	/* Buffer for stat() calls */
    int fhIndex;	/* File handle for index-file */
    int fhReadlock;	/* File handle for read lock file */
    FILE *fpIndexinfo;	/* File pointer for index.info file */
    int i, j;		/* Loop variables */
    int version;	/* Version read */
    char *cPtr;		/* Running pointer */

    /*
     * First make sure we know where the database should reside and which
     * identifier we should use.
     */
    if (0 == dbDir) {
	Tcl_DString ds;	/* Scratch area */
	char *value;	/* Value of "dbase_dir" option */

	value = Tcl_GetVar2(interp, "option", "dbase_dir", TCL_GLOBAL_ONLY);
	if (NULL == value) {
	    Tcl_SetResult(interp, "option(dbase_dir) has no value", TCL_STATIC);
	    return TCL_ERROR;
	}
	dbDir = cpystr(Tcl_TildeSubst(interp, value, &ds));
	Tcl_DStringFree(&ds);
    }
    if (0 == ident) {
	gethostname(buf, sizeof(buf));
	ident = (char*)ckalloc(strlen(buf)+16);
	sprintf(ident, "%s:%d", buf, (int)getpid());
    }

    /*
     * Check if the database actually exists. If it doesn't then we
     * must create the needed directories and files.
     */
    sprintf(buf, "%s/index", dbDir);
    if (       (0 != stat(dbDir, &sbuf) && ENOENT == errno)
	    || (0 != stat(buf, &sbuf) && ENOENT == errno)) {
	if (0 != mkdir(dbDir, DIRMODE) && EEXIST != errno) {
	    Tcl_AppendResult(interp, "error creating directory \"", dbDir,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}
	sprintf(buf, "%s/dbase", dbDir);
	if (0 != mkdir(buf, DIRMODE) && EEXIST != errno) {
	    Tcl_AppendResult(interp, "error creating directory \"", buf,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}

	Lock(interp);

	sprintf(buf, "%s/index", dbDir);
	if (0 > (fhIndex = open(buf, O_CREAT|O_WRONLY, FILEMODE))
		|| 0 != close(fhIndex)) {
	    Unlock(interp);
	    Tcl_AppendResult(interp, "error creating file \"", buf,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}
	sprintf(buf, "%s/index.info", dbDir);
	if (0 == (fpIndexinfo = fopen(buf, "w"))) {
	    Unlock(interp);
	    Tcl_AppendResult(interp, "error creating file \"", buf,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}
	if (0 > fprintf(fpIndexinfo, "%d 0\n", DBASE_VERSION)) {
	    Unlock(interp);
	    Tcl_AppendResult(interp, "error writing to file \"", buf, "\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (0 != fclose(fpIndexinfo)) {
	    Unlock(interp);
	    Tcl_AppendResult(interp, "error closing file \"", buf,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}
    } else {
	Lock(interp);
    }

    /*
     * Create rlock file.
     */
    sprintf(buf, "%s/rlock.%s", dbDir, ident);
    if (0 > (fhReadlock = open(buf, O_CREAT|O_WRONLY, FILEMODE))
	    || 0 != close(fhReadlock)) {
	Unlock(interp);
	Tcl_AppendResult(interp, "error creating file \"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }
    (void)Tk_CreateTimerHandler(UPDATE_INTERVAL*1000, Update, (ClientData)NULL);

    /*
     * Read the index.info file
     */
    sprintf(buf, "%s/index.info", dbDir);
    if (0 == (fpIndexinfo = fopen(buf, "r"))) {
	Tcl_AppendResult(interp, "error opening file (for reading)\"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	goto error;
    }
    if ( 2 != fscanf(fpIndexinfo, "%d %d", &version, &numRead)) {
	Tcl_SetResult(interp, "index.info file corrupt", TCL_STATIC);
	fclose(fpIndexinfo);
	goto error;
    }
    fclose(fpIndexinfo);

    /*
     * Check if this is the current version of the database. If not
     * complain!
     */
    if (version != DBASE_VERSION) {
	sprintf(buf, "wrong version of database got %d expected %d", version,
		DBASE_VERSION);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	goto error;
    }

    /*
     * Read the indexfile and build internal data structures
     */
    sprintf(buf, "%s/index", dbDir);
    if (0 != stat(buf, &sbuf)) {
	Tcl_AppendResult(interp, "error stating file \"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	goto error;
    }
    size = sbuf.st_size;
    if (size > 0) {
	char *indexPtr;	/* Pointer to read version of the indexfile */

	/*
	 * We should not free this value since we never close the database.
	 * Purify will note it as a leak, but we will have lots of
	 * pointers into this data.
	 */
	if ( 0 == (indexPtr = (char*)ckalloc(size))) {
	    Tcl_SetResult(interp, "failed to allocate memory for index",
		    TCL_STATIC);
	    goto error;
	}
	fhIndex = open(buf, O_RDONLY);
	if (size != read(fhIndex, indexPtr, size)) {
	    Tcl_SetResult(interp, "error reading index", TCL_STATIC);
	    close(fhIndex);
	    goto error;
	}
	close(fhIndex);
	entryPtr = (RatDbEntry*)ckalloc((numRead+EXTRA_ENTRIES) *
		sizeof(RatDbEntry));
	numAlloc = numRead+EXTRA_ENTRIES;

	cPtr = indexPtr;
	for (i=0; i<numRead; i++) {
	    for (j=0; j<RATDBETYPE_END; j++) {
		entryPtr[i].content[j] = cPtr;
		while (cPtr <= &indexPtr[size] && *cPtr != '\n') {
		    cPtr++;
		}
		if (cPtr > &indexPtr[size]) {
		    Tcl_SetResult(interp, "error in index-file", TCL_STATIC);
		    ckfree(indexPtr);
		    goto error;
		}
		*cPtr++ = '\0';
	    }
	    /*
	     * This is a KLUDGE to work around a bug which existed for a
	     * short time /MaF 960218
	     */
	    if ('+' == entryPtr[i].content[EX_TYPE][0]) {
		char buf[64];
		sprintf(buf, "%d", atoi(entryPtr[i].content[EX_TYPE])*24*60*60+
			    atoi(entryPtr[i].content[DATE]));
		entryPtr[i].content[EX_TIME] = cpystr(buf);
		entryPtr[i].content[EX_TYPE] = "backup";
	    }
	}
    } else {
	entryPtr = (RatDbEntry*)ckalloc(EXTRA_ENTRIES * sizeof(RatDbEntry));
	numAlloc = EXTRA_ENTRIES;
    }
    isRead = 1;

    /*
     * Let's get up to date with any changes made.
     */
    Sync(interp);
    Unlock(interp);

    return TCL_OK;

error:
    sprintf(buf, "%s/rlock.%s", dbDir, ident);
    unlink(buf);
    Unlock(interp);
    return TCL_ERROR;
}


/*
 *----------------------------------------------------------------------
 *
 * Lock --
 *
 *      Exculsively lock the database. A lock like this must be obtained
 *	before you do anything at all with the database. And while a
 *	lock like this is active nobody but the owner of the lock may
 *	do anything to the database. The lock obtained must be released
 *	with a call to the Unlock() procedure.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Creates a lockfile in the database directory.
 *
 *----------------------------------------------------------------------
 */

static void
Lock(Tcl_Interp *interp)
{
    char buf[1024];	/* Scratch area */
    int fhLock;		/* Lockfile filehandle */
    int msgPost = 0;	/* True of message has been posted */

    do {
	sprintf(buf, "%s/lock", dbDir);
	if (-1 == (fhLock = open(buf, O_CREAT|O_EXCL|O_WRONLY, FILEMODE))) {
	    if (EEXIST == errno) {
		if (!msgPost) {
		    sprintf(buf, "RatLog 2 $t(waiting_dbase_lock) explicit");
		    Tcl_Eval(interp, buf);
		    msgPost = 1;
		}
		sleep(2);
	    } else {
		sprintf(buf, "Failed to create lockfile \"%s\": %s",
			buf, Tcl_PosixError(interp));
		RatLog(interp, RAT_FATAL, buf, 0);
		exit(1);
	    }
	}
    } while (-1 == fhLock);
    write(fhLock, ident, strlen(ident));
    close(fhLock);
    if (msgPost) {
	sprintf(buf, "RatClearLog %s; update idletasks", interp->result);
	Tcl_Eval(interp, buf);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * Unlock --
 *
 *      Releases a lock previously obtained with the Lock() procedure.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The lockfile is removed.
 *
 *----------------------------------------------------------------------
 */

static void
Unlock(Tcl_Interp *interp)
{
    char buf[1024];	/* Scratch area */

    sprintf(buf, "%s/lock", dbDir);
    if (0 != unlink(buf)) {
	char errMsg[1024];
	sprintf(errMsg, "Failed to unlink lockfile \"%s\": %s", buf,
		Tcl_PosixError(interp));
	RatLog(interp, RAT_FATAL, errMsg, 0);
	exit(1);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * Sync --
 *
 *      Make sure that the database in memory is consistent with the
 *	master on disk. This is accomplished by reading the index.changes
 *	file. This call assumes that we have an exclusive lock on the
 *	database.
 *
 * Results:
 *      The return value is normally TCL_OK; if something goes wrong
 *	TCL_ERROR is returned and an error message will be left in
 *	interp->result.
 *
 * Side effects:
 *      The internal list of entries may be affected as well as the
 *	index-file on disk.
 *
 *----------------------------------------------------------------------
 */

static int
Sync(Tcl_Interp *interp)
{
    char buf[1024];	   /* Scratch area */
    struct stat sbuf;	   /* Buffer for stat() calls */
    FILE *fpChanges;	   /* index.changes file pointer */
    FILE *fpIndex;	   /* Index file pointer */
    char command;	   /* Command in changes file */
    int cmdArg;		   /* Argument to command */
    int i;		   /* Loop counter */
    int doWrite = 0;	   /* 1 if we should write the changes to the disk */
    int needRewrite = 0;   /* 1 if we need to rewrite the indexfile */
    int numEntries = 0;	   /* How many entries there actually are */
    char *indexBuf = NULL; /* New part of index file */
    int indexOffset = 0;   /* Offset of new part of index file */
    char *cPtr;

    sprintf(buf, "%s/index.changes", dbDir);
    if (0 > stat(buf, &sbuf)) {
	if (ENOENT != errno) {
	    Tcl_AppendResult(interp, "error stating file \"", buf,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (changeSize >= sbuf.st_size) {
	return TCL_OK;
    }

    /*
     * Read and perform changes mentioned in index.changes file
     */
    if (0 == (fpChanges = fopen(buf, "r"))) {
	Tcl_AppendResult(interp, "error opening file (for reading) \"",
		buf, "\": ", Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }
    if (0 != fseek(fpChanges, changeSize, SEEK_SET)) {
	Tcl_AppendResult(interp, "error seeking in file \"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	fclose(fpChanges);
	return TCL_ERROR;
    }
    changeSize = sbuf.st_size;
    while(1) {
	if (2 != fscanf(fpChanges, "%c %d ", &command, &cmdArg) ||
		('d'!=command && 'a'!=command && 's'!=command)
		|| ('s' == command &&
		buf != fgets(buf, sizeof(buf), fpChanges))) {
	    if (feof(fpChanges)) {
		break;
	    }
	    Tcl_SetResult(interp, "syntax error in changes file",
		    TCL_STATIC);
	    fclose(fpChanges);
	    return TCL_ERROR;
	}
	numChanges++;
	if ('d' == command) {
	    if (cmdArg < 0 || cmdArg >= numRead) {
		continue;
	    }
	    needRewrite = 1;
	    entryPtr[cmdArg].content[FROM] = NULL;
	} else if ('s' == command) {
	    if (cmdArg < 0 || cmdArg >= numRead) {
		continue;
	    }
	    needRewrite = 1;
	    buf[strlen(buf)-1] = '\0';
	    if ( (int) strlen(buf) <=
		    (int) strlen(entryPtr[cmdArg].content[STATUS])){
		strcpy(entryPtr[cmdArg].content[STATUS], buf);
	    } else {
		/*
		 * This code may leak the memory occupied by the
		 * previous status string. I believe this loss can
		 * be lived with (it should be quite rare).
		 */
		entryPtr[cmdArg].content[STATUS] =
			(char *) ckalloc(strlen(buf)+1);
		strcpy(entryPtr[cmdArg].content[STATUS], buf);
	    }
	} else {
	    if (numRead == numAlloc) {
		numAlloc += EXTRA_ENTRIES;
		entryPtr = (RatDbEntry*)REALLOC(entryPtr,
			numAlloc*sizeof(RatDbEntry));
	    }
	    if (!indexBuf) {
		sprintf(buf, "%s/index", dbDir);
		if (NULL == (fpIndex = fopen(buf, "r"))) {
		    Tcl_AppendResult(interp,
			    "error opening file (for reading) \"", buf,
			    "\": ", Tcl_PosixError(interp), (char *) NULL);
		    fclose(fpChanges);
		    return TCL_ERROR;
		}
		if (0 != fseek(fpIndex, cmdArg, SEEK_SET)) {
		    Tcl_AppendResult(interp, "error seeking in file \"",buf,
			    "\": ", Tcl_PosixError(interp), (char *) NULL);
		    fclose(fpIndex);
		    fclose(fpChanges);
		    return TCL_ERROR;
		}
		(void)fstat(fileno(fpIndex), &sbuf);
		/*
		 * Purify will probably report this as a leak, but that
		 * is not true.
		 */
		indexBuf = (char*)malloc(sbuf.st_size - cmdArg + 1);
		fread(indexBuf, sbuf.st_size - cmdArg, 1, fpIndex);
		fclose(fpIndex);
		indexBuf[sbuf.st_size - cmdArg] = '\0';
		indexOffset = cmdArg;
	    }
	    cPtr = indexBuf + (cmdArg - indexOffset);
	    for (i=0; i<RATDBETYPE_END; i++) {
		entryPtr[numRead].content[i] = cPtr;
		for (; *cPtr != '\n' && *cPtr; cPtr++);
		if (!*cPtr) {
		    Tcl_AppendResult(interp, "error reading \"",buf,
			    "\": ", Tcl_PosixError(interp),(char*)NULL);
		    fclose(fpChanges);
		    return TCL_ERROR;
		}
		*cPtr++ = '\0';
	    }
	    numRead++;
	}
    }
    fclose(fpChanges);

    /* 
     * If the number of changes is at least 20 and we are the only agent
     * which have the database open we write the changes into the main
     * index.
     */
    /*
     * Check that we are the only agent who has the database open.
     * But only if have enough changes to write.
     */
    if (20 <= numChanges) {
	char myLock[1024];		/* Name of my rlock file */
	sprintf(myLock, "rlock.%s", ident);

	if (IsRlocked(myLock)) {
	    doWrite = 0;
	} else {
	    doWrite = 1;
	}
    }

    if (doWrite) {
	FILE *fpIndexinfo;		/* Filepointer to index info */
	if (needRewrite) {
	    char oldIndex[1024];	/* Name of old index file */
	    char newIndex[1024];	/* Name of new index file */
	    FILE *fpNewIndex;		/* Filepointer to new index */
	    int j;			/* Loop variable */

	    sprintf(oldIndex, "%s/index", dbDir);
	    sprintf(newIndex, "%s/index.new", dbDir);
	    if (0 == (fpNewIndex = fopen(newIndex, "w"))) {
		Tcl_AppendResult(interp, "error creating file \"", newIndex,
			"\": ", Tcl_PosixError(interp), (char *) NULL);
		return TCL_ERROR;
	    }
	    if (0 == (fpIndex = fopen(oldIndex, "r"))) {
		Tcl_AppendResult(interp, "error opening file (for reading)\"",
			oldIndex,"\": ", Tcl_PosixError(interp), (char *) NULL);
		(void)fclose(fpNewIndex);
		return TCL_ERROR;
	    }

	    for (i=0 ; i < numRead; i++) {
		if (0 != entryPtr[i].content[FROM]) {
		    numEntries++;
		    for (j=0; j<RATDBETYPE_END; j++) {
			if (0 > fprintf(fpNewIndex, "%s\n",
				entryPtr[i].content[j])) {
			    Tcl_AppendResult(interp,"error writing to file \"",
				    newIndex, "\"", (char *) NULL);
			    (void)fclose(fpNewIndex);
			    (void)unlink(newIndex);
			    (void)fclose(fpIndex);
			    return TCL_ERROR;
			}
		    }
		} else {
		    sprintf(buf, "%s/dbase/%s", dbDir,
			    entryPtr[i].content[FILENAME]);
		    (void)unlink(buf);
		}
	    }
	    (void)fclose(fpIndex);
	    if (0 != fclose(fpNewIndex)) {
		Tcl_AppendResult(interp,"error closing file \"", newIndex,
			"\": ", Tcl_PosixError(interp), (char *) NULL);
		(void)unlink(newIndex);
		return TCL_ERROR;
	    }
	    if (0 != rename(newIndex, oldIndex)) {
		Tcl_AppendResult(interp,"error moving file \"", newIndex,
			"\" -> \"", oldIndex, "\": ", Tcl_PosixError(interp),
			(char *) NULL);
		return TCL_ERROR;
	    }
	} else {
	    numEntries = numRead;
	}
	sprintf(buf, "%s/index.info", dbDir);
	if (0 == (fpIndexinfo = fopen(buf, "w"))) {
	    Tcl_AppendResult(interp, "error opening file (for writing)\"",
		    buf, "\": ", Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}
	if (0 > fprintf(fpIndexinfo, "%d %d\n", DBASE_VERSION, numEntries)) {
	    Tcl_AppendResult(interp, "error writing to file \"", buf, "\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (0 > fclose(fpIndexinfo)) {
	    Tcl_AppendResult(interp, "error closing file \"", buf,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}
	sprintf(buf, "%s/index.changes", dbDir);
	if (0 != unlink(buf)) {
	    Tcl_AppendResult(interp, "error unlinking file \"", buf,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}
	changeSize = 0;
	numChanges = 0;
    }

    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * Update --
 *
 *      This routine updates the read-lock we have on the database. This
 *	must be done at least as often as is specified by the Read
 *	rotine. Preferably more often. If the database hasn't been read
 *	yet (or has been closed) this routine does nothing.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The rlock-file will be touched (if the database is open).
 *
 *----------------------------------------------------------------------
 */

static void
Update(ClientData clientData)
{
    char rlockName[1024];	/* Name of rlock file */

    if (0 != isRead) {
	return;
    }

    sprintf(rlockName, "%s/rlock.%s", dbDir, ident);
    (void)utime(rlockName, (struct utimbuf*) NULL);

    (void)Tk_CreateTimerHandler(UPDATE_INTERVAL*1000, Update, (ClientData)NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * IsRlocked --
 *
 *      Checks if any othe rprocess has an read lock on the database.
 *
 * Results:
 *      True if any othe rprocess has.
 *
 * Side effects:
 *      Stale rlock-files will be removed
 *
 *----------------------------------------------------------------------
 */

static int
IsRlocked(char *ignore)
{
    time_t deadline;		/* Lockfiles older than this can be ignored */
    struct dirent *direntPtr;
    struct stat sbuf;
    int result = 0;
    DIR *dirPtr;
    char buf[1024];

    deadline = time((time_t*) NULL) - RLOCK_TIMEOUT;

    dirPtr = opendir(dbDir);
    while (0 != (direntPtr = readdir(dirPtr))) {
	if (!strncmp("rlock.", (char*)direntPtr->d_name, 6)
		&& (ignore && strcmp((char*)direntPtr->d_name, ignore))) {
	    sprintf(buf, "%s/%s", dbDir, (char*)direntPtr->d_name);
	    (void)stat(buf, &sbuf);
	    if (deadline < sbuf.st_mtime) {
		result = 1;
		break;
	    } else {
		unlink(buf);
	    }
	}
    }
    closedir(dirPtr);
    return result;
}


/*
 *----------------------------------------------------------------------
 *
 * RatDbInsert --
 *
 *      This procedure inserts a copy of the message, whose id is passed
 *	in the mail parameter, into the database. An entry is made in the
 *	index file. One of the arguments is the expiration date as a string.
 *	This string is the number of days the message should stay in the
 *	database until it expires.
 *
 *	The algorithm is to update the index on disk and then let Sync()
 *	insert the new value into the internal database.
 *
 * Results:
 *      The return value is normally TCL_OK; if something goes wrong
 *	TCL_ERROR is returned and an error message will be left in
 *	interp->result.
 *
 * Side effects:
 *      The internal and external databases are updated.
 *
 *----------------------------------------------------------------------
 */

int
RatDbInsert(Tcl_Interp *interp, char *to, char *from, char *cc, char *subject,
	    int date, char *flags, char *keywords, int exDate, char *exType,
	    char *fromline, char *mail, int length)
{
    char fname[1024];		/* filename of new entry */
    char buf[1024];		/* Scratch area */
    char *dir;			/* Message directory */
    FILE *indexFP;		/* File pointer to index file */
    long indexPos;		/* Start position in index file */
    char *cPtr;			/* Misc character pointer */
    FILE *seqFP;		/* Filepointer to seq file */
    int seq;			/* sequence number */
    FILE *indchaFP;		/* File pointer to the index.changes file */
    Tcl_Channel dataChannel;	/* Data channel */
    ADDRESS *adrPtr;		/* Address list */
    int mode;			/* Mode to use when creating files */
    int i;

    /*
     * Get file creation mode
     */
    Tcl_GetInt(interp, Tcl_GetVar2(interp, "option", "permissions",
	    TCL_GLOBAL_ONLY), &mode);

    if (0 == isRead) {
	if (TCL_OK != Read(interp)) {
	    return TCL_ERROR;
	}
    }
    Lock(interp);

    /*
     * Generate the filename we are to use for this entry in the database.
     * Create the directory it will be stored in too (if needed).
     */
    adrPtr = NULL;
    if (to && *to) {
	strcpy(buf, to);
	rfc822_parse_adrlist(&adrPtr, buf, currentHost);
	dir = cpystr(adrPtr->mailbox);
    } else {
	dir = cpystr(currentMailboxName);
    }
    mail_free_address(&adrPtr);

    sprintf(fname, "%s/", dir);
    sprintf(buf, "%s/dbase/%s/.seq", dbDir, dir);
    if (NULL == (seqFP = fopen(buf, "r+"))) {
	sprintf(buf, "%s/dbase/%s", dbDir, dir);
	if (0 != mkdir(buf, DIRMODE) && EEXIST != errno) {
	    Unlock(interp);
	    Tcl_AppendResult(interp, "error creating directory \"", buf,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	    ckfree(dir);
	    return TCL_ERROR;
	}
	seq = 0;
	sprintf(buf, "%s/dbase/%s/.seq", dbDir, dir);
	if (NULL == (seqFP = fopen(buf, "w"))) {
	    Unlock(interp);
	    Tcl_AppendResult(interp, "error opening (for writing)\"", buf,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	    ckfree(dir);
	    return TCL_ERROR;
	}
    } else {
	if (1 != fscanf(seqFP, "%d", &seq)) {
	    (void)fclose(seqFP);
	    Unlock(interp);
	    Tcl_AppendResult(interp, "error parsing: \"", buf, "\"",
		    (char*) NULL);
	    ckfree(dir);
	    return TCL_ERROR;
	}
	seq++;
    }
    ckfree(dir);
    rewind(seqFP);
    if (0 > fprintf(seqFP, "%d", seq)) {
	(void)fclose(seqFP);
	Unlock(interp);
	Tcl_AppendResult(interp, "error writing to \"", buf,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }
    if (0 != fclose(seqFP)) {
	Unlock(interp);
	Tcl_AppendResult(interp, "error closing file \"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }
    sprintf(buf, "%d", seq);
    cPtr = fname + strlen(fname);
    for (i=strlen(buf)-1; i>=0; i--) {
	*cPtr++ = buf[i];
    }
    *cPtr = '\0';

    /*
     * Open the indexfile and remember where we are
     */
    sprintf(buf, "%s/index", dbDir);
    if (NULL == (indexFP = fopen(buf, "a"))) {
	Unlock(interp);
	Tcl_AppendResult(interp, "error opening (for append)\"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }
    indexPos = ftell(indexFP);

    /*
     * Construct the entries... some are simple some others are more
     * complicated :-) The order and format of the entries is documented
     * at the top of this file.
     */
    NoLFPrint(indexFP, to);
    NoLFPrint(indexFP, from);
    NoLFPrint(indexFP, cc);
    NoLFPrint(indexFP, subject);
    fprintf(indexFP, "%d\n", date);
    NoLFPrint(indexFP, keywords);
    fprintf(indexFP, "%d\n", length);
    NoLFPrint(indexFP, flags);
    fprintf(indexFP, "%ld\n", exDate*24*60*60 + time((time_t*) NULL));
    NoLFPrint(indexFP, exType);
    if (0 > NoLFPrint(indexFP, fname)) {
	goto losing;
    }
    if (0 != fclose(indexFP)) {
	Tcl_AppendResult(interp, "error closing index file :",
		Tcl_PosixError(interp), (char *) NULL);
	goto losing;
    }

    /*
     * Create the actual entry in the database.
     */
    sprintf(buf, "%s/dbase/%s", dbDir, fname);
    if (NULL == (dataChannel = Tcl_OpenFileChannel(interp, buf, "w", mode))) {
	Tcl_AppendResult(interp, "error creating file \"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	goto losing;
    }
    Tcl_Write(dataChannel, fromline, strlen(fromline));
    Tcl_Write(dataChannel, mail, length);
    if (TCL_OK != Tcl_Close(interp, dataChannel)) {
	Tcl_AppendResult(interp, "error closing file \"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	goto losing_but_nearly_got_it;
    }

    /*
     * Write an entry to the index.changes file and then update
     */
    sprintf(buf, "%s/index.changes", dbDir);
    if (NULL == (indchaFP = fopen(buf, "a"))) {
	Tcl_AppendResult(interp, "error opening file (for append)\"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	goto losing_but_nearly_got_it;
    }
    if (0 > fprintf(indchaFP, "a %ld\n", indexPos)) {
	Tcl_AppendResult(interp, "error writing to file \"", buf, "\"",
		(char *) NULL);
	goto losing_but_nearly_got_it;
    }
    if (0 != fclose(indchaFP)) {
	Tcl_AppendResult(interp, "error closing file \"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	goto losing_but_nearly_got_it;
    }
    Sync(interp);

    Unlock(interp);
    return TCL_OK;

losing_but_nearly_got_it:
    sprintf(buf, "%s/dbase/%s", dbDir, fname);
    (void)unlink(buf);

losing:
    (void)sprintf(buf, "%s/index", dbDir);
    (void)truncate(buf, indexPos);
    Unlock(interp);

    return TCL_ERROR;
}


/*
 *----------------------------------------------------------------------
 *
 * RatDbSetStatus --
 *
 *	This procedure modifies the status of the given message.
 *
 * Results:
 *      The return value is normally TCL_OK; if something goes wrong
 *	TCL_ERROR is returned and an error message will be left in
 *	interp->result.
 *
 * Side effects:
 *      The internal and external databases are updated.
 *
 *----------------------------------------------------------------------
 */

int
RatDbSetStatus(Tcl_Interp *interp, int index, char *status)
{
    char buf[1024];	/* Name of index.changes file */
    FILE *indexFP;	/* FIle pointer to index.changes file */

    /*
     * Check the index for validity.
     */
    if (index >= numRead || index < 0) {
	Tcl_SetResult(interp, "error: the given index is invalid", TCL_STATIC);
	return TCL_ERROR;
    }

    /*
     * Check if we really need to do this
     */
    if (!strcmp(status, entryPtr[index].content[STATUS])) {
	return TCL_OK;
    }

    Lock(interp);
    sprintf(buf, "%s/index.changes", dbDir);
    if (NULL == (indexFP = fopen(buf, "a"))) {
	Tcl_AppendResult(interp, "error opening (for append)\"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	Unlock(interp);
	return TCL_ERROR;
    }
    if (0 > fprintf(indexFP, "s %d %s\n", index, status)){
	Tcl_AppendResult(interp, "Failed to write to file \"", buf, "\"",
		(char*) NULL);
	(void)fclose(indexFP);
	Unlock(interp);
	return TCL_ERROR;
    }
    if (0 != fclose(indexFP)) {
	Tcl_AppendResult(interp, "error closing file \"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	Unlock(interp);
	return TCL_ERROR;
    }

    Sync(interp);
    Unlock(interp);
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * RatDbSearch --
 *
 *      Searches the database for entries matching the given expression.
 *	The search expression is in the following form:
 *	    op exp [exp ...]
 *	Where op is either "and" or "or". and exp is as follows:
 *	    [not] field value
 *	Where field is one of "to", "from", "cc", "subject", "keywords"
 *	and "all". if op is "and" the all following expressions must be
 *	true but if it is "or" then only one has to be true.
 *
 * Results:
 *      The number of items found is returned in numFoundPtr if it is
 *	non zero a pointer to a list of found ones is put into *foundPtrPtr.
 *	It is the callers resopnsibility to free this list with a
 *	call to free(). The rotine normally returns TCL_OK except when
 *	there is an error. In that case TCL_ERROR is returned and the cause
 *	may be found in interp->error.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
RatDbSearch(Tcl_Interp *interp, char *exp, int *numFoundPtr, int **foundPtrPtr)
{
    int or;			/* Indicates the operation; 0 = and  1 = or */
    int i, j, k;		/* Loop counters */
    int match;
    int numAlloc = 0;		/* Number of entries allocated room for */
    int expNumWords, argc;
    char **expWords, **argv;
    int numExp;			/* The number of subexpressions in the exp */
    char fname[1024];		/* Filename of actual message */
    int bodyfd;			/* File descriptor to actual message */
    char *message = NULL;	/* Actual message */
    int messageSize = 0;	/* Size of message area */
    struct stat sbuf;		/* Buffer for stat calls */
    /*
     * The following three lists describes the search expression. Every
     * expression has one entry in each list.
     */
    int *notPtr;
    RatDbEType *fieldPtr;
    char **valuePtr;

    *numFoundPtr = 0;
    *foundPtrPtr = NULL;

    /*
     * Parse the expression and build the lists.
     */
    if (TCL_OK != Tcl_SplitList(interp, exp, &expNumWords, &expWords)) {
	return TCL_ERROR;
    }
    if (!strcmp(*expWords, "and") && !strcmp(*expWords, "or")) {
	Tcl_SetResult(interp, "exp must start with \"and\" or \"or\".",
		TCL_STATIC);
	return TCL_ERROR;
    }
    notPtr = (int*) ckalloc(sizeof(int) * (expNumWords/2));
    fieldPtr = (RatDbEType*) ckalloc(sizeof(RatDbEType) * (expNumWords/2));
    valuePtr = (char**) ckalloc(sizeof(char*) * (expNumWords/2));

    expNumWords--;
    if (!strcmp(*expWords, "or")) {
	or = 1;
    } else {
	or = 0;
    }

    numExp = 0;
    i = 1;
    while (i < expNumWords) {
	if (!strcmp(expWords[i], "not")) {
	    notPtr[numExp] = 1;
	    i++;
	} else {
	    notPtr[numExp] = 0;
	}

	if (i > expNumWords-1) {
	    Tcl_SetResult(interp, "Parse error in exp (to few words)",
		    TCL_STATIC);
	    goto losing;
	}
	if (!strcmp(expWords[i], "to")) {
	    fieldPtr[numExp] = TO;
	} else if (!strcmp(expWords[i], "from")) {
	    fieldPtr[numExp] = FROM;
	} else if (!strcmp(expWords[i], "cc")) {
	    fieldPtr[numExp] = CC;
	} else if (!strcmp(expWords[i], "subject")) {
	    fieldPtr[numExp] = SUBJECT;
	} else if (!strcmp(expWords[i], "keywords")) {
	    fieldPtr[numExp] = KEYWORDS;
	} else if (!strcmp(expWords[i], "all")) {
	    fieldPtr[numExp] = -1;
	} else {
	    Tcl_SetResult(interp, "Parse error in exp (illegal field value)",
		    TCL_STATIC);
	    goto losing;
	}
	i++;
	valuePtr[numExp++] = expWords[i++];
    }

    /*
     * Now we are ready to do the searching. First make sure that the
     * database is read and synced, then run through it.
     */
    if (0 == isRead) {
	if (TCL_OK != Read(interp)) {
	    goto losing;
	}
    } else {
	if (TCL_OK != Sync(interp)) {
	    goto losing;
	}
    }
    for (i=0; i < numRead; i++) {
	if (!entryPtr[i].content[FROM]) {	/* Entry deleted */
	    continue;
	}
	match = 0;
	for(j=0; j < numExp && !(j != 0 && or == match); j++) {
    	    Tcl_SplitList(interp, valuePtr[j], &argc, &argv);
	    for (k=0; k<argc && !(k != 0 && or == match); k++) {
		if (fieldPtr[j] == -1) {
		    sprintf(fname, "%s/dbase/%s", dbDir,
			    entryPtr[i].content[FILENAME]);
		    if (0 > (bodyfd = open(fname, O_RDONLY))) {
			Tcl_AppendResult(interp,
				"error opening file (for read)\"", fname,
				"\": ", Tcl_PosixError(interp), (char*)NULL);
			goto losing;
		    }
		    if (0 != fstat(bodyfd, &sbuf)) {
			Tcl_AppendResult(interp, "error stating file \"", fname,
				"\": ", Tcl_PosixError(interp), (char *) NULL);
			close(bodyfd);
			goto losing;
		    }
		    if (messageSize < sbuf.st_size+1) {
			ckfree(message);
			message = (char*)ckalloc(messageSize = sbuf.st_size+1);
		    }
		    read(bodyfd, message, sbuf.st_size);
		    message[sbuf.st_size] = '\0';
		    (void)close(bodyfd);
		    match = RatSearch(argv[k], message);
		} else {
		    match = RatSearch(argv[k],entryPtr[i].content[fieldPtr[j]]);
		}
		if (1 == notPtr[j]) {
		    match = match ? 0 : 1;
		}
	    }
	    free(argv);
	}

	if (match) {
	    if (*numFoundPtr >= numAlloc) {
		numAlloc += EXTRA_ENTRIES;
		*foundPtrPtr = (int*)REALLOC(*foundPtrPtr,numAlloc*sizeof(int));
	    }
	    (*foundPtrPtr)[(*numFoundPtr)++] = i;
	}
    }

    ckfree((char*) expWords);
    ckfree((char*) notPtr);
    ckfree((char*) fieldPtr);
    ckfree((char*) valuePtr);
    if (messageSize > 0) {
	ckfree(message);
    }

    return TCL_OK;

losing:
    ckfree((char*) expWords);
    ckfree((char*) notPtr);
    ckfree((char*) fieldPtr);
    ckfree((char*) valuePtr);
    if (messageSize > 0) {
	ckfree(message);
    }

    return TCL_ERROR;
}


/*
 *----------------------------------------------------------------------
 *
 * RatDbGetEntry --
 *
 *      This routine retrieves an entry from the database. The pointer
 *	returned is ONLY good until the next call to RatDbInsert(),
 *	RatDbSetStatus(), RatDbSearch(), RatDbDelete().
 *
 * Results:
 *      The routine returns a pointer to a RatDbEntry structure which
 *	should be treated as read only. If the index is invalid or
 *	points to a deleted entry a null pointer is returned.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

RatDbEntry*
RatDbGetEntry(int index)
{
    if (index<0 || index>=numRead || NULL == entryPtr[index].content[FROM]) {
	return NULL;
    }

    return &entryPtr[index];
}


/*
 *----------------------------------------------------------------------
 *
 * RatDbGetMessage --
 *
 *      This routine extracts a copy of a message in the database and
 *	returns a MESSAGE structure.
 *
 * Results:
 *	A pointer to a MESSAGE* structure. It alse fills in the pointer
 *	to a buffer among the arguments with the address that needs to be
 *	freed when the message is deleted.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

MESSAGE*
RatDbGetMessage(Tcl_Interp *interp, int index, char **buffer)
{
    char fname[1024];	/* Filename of message */
    int messfd;		/* Message file descriptor */
    struct stat sbuf;	/* Buffer for stat call (to find out size of message)*/
    char *message;	/* Pointer to actual message */

    /*
     * Check the index for validity.
     */
    if (index >= numRead || index < 0) {
	Tcl_SetResult(interp, "error: the given index is invalid", TCL_STATIC);
	return NULL;
    }
    if (NULL == entryPtr[index].content[FROM]) {
	Tcl_SetResult(interp, "error: the message is deleted", TCL_STATIC);
	return NULL;
    }

    Lock(interp);

    /*
     * Read the message into an array pointed to by 'message'.
     */
    sprintf(fname, "%s/dbase/%s", dbDir, entryPtr[index].content[FILENAME]);
    if (0 > (messfd = open(fname, O_RDONLY))) {
	Unlock(interp);
	Tcl_AppendResult(interp, "error opening file (for read)\"",
		fname, "\": ", Tcl_PosixError(interp), (char*)NULL);
	return NULL;
    }
    if (0 != fstat(messfd, &sbuf)) {
	Unlock(interp);
	Tcl_AppendResult(interp, "error stating file \"", fname,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	close(messfd);
	return NULL;
    }
    *buffer = message = (char*)ckalloc(sbuf.st_size+1);
    read(messfd, message, sbuf.st_size);
    message[sbuf.st_size] = '\0';
    (void)close(messfd);

    Unlock(interp);

    return RatParseMsg(interp, message);
}


/*
 *----------------------------------------------------------------------
 *
 * RatDbGetHeaders --
 *
 *      This routine extracts a copy of the headers of a message in
 *	the database.
 *
 * Results:
 *      A pointer to a static area containing the message headers
 *	is returned.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

char*
RatDbGetHeaders(Tcl_Interp *interp, int index)
{
    static char *header;	/* Static storage area */
    static int headerSize = 0;	/* Size of static storage area */
    char fname[1024];		/* Filename of message */
    char buf[2048];		/* Temporary holding area */
    char *hPtr;			/* The header to return */
    FILE *messFp;		/* Message file pointer */
    int length = 0;		/* Length of header */

    /*
     * Check the index for validity.
     */
    if (index >= numRead || index < 0) {
	Tcl_SetResult(interp, "error: the given index is invalid", TCL_STATIC);
	return NULL;
    }
    if (NULL == entryPtr[index].content[FROM]) {
	Tcl_SetResult(interp, "error: the message is deleted", TCL_STATIC);
	return NULL;
    }

    Lock(interp);

    /*
     * Read the message into an array pointed to by 'message'.
     */
    sprintf(fname, "%s/dbase/%s", dbDir, entryPtr[index].content[FILENAME]);
    if (NULL == (messFp = fopen(fname, "r"))) {
	Unlock(interp);
	Tcl_AppendResult(interp, "error opening file (for read)\"",
		fname, "\": ", Tcl_PosixError(interp), (char*)NULL);
	return NULL;
    }
    while (fgets(buf, sizeof(buf), messFp), !feof(messFp)) {
	if ('\n' == buf[0]) {
	    length = ftell(messFp)-1;
	    break;
	}
	if ('\r' == buf[0]) {
	    length = ftell(messFp)-2;
	    break;
	}
    }
    if (length == 0) {
	fseek(messFp, 0, SEEK_END);
	length = ftell(messFp);
    }
    if (length+1 > headerSize) {
	ckfree(header);
	headerSize = length+1;
	header = (char*)ckalloc(headerSize);
    }
    rewind(messFp);
    fread(header, length, 1, messFp);
    fclose(messFp);
    header[length] = '\0';
    Unlock(interp);
    if (strncmp("From ", header, 5)) {
	hPtr = header;
    } else {
	hPtr = strchr(header, '\n')+1;
	if ('\r' == *hPtr) {
	    hPtr++;
	}
    }
    return hPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * RatDbGetText --
 *
 *      This routine extracts a copy of the body of a message in
 *	the database.
 *
 * Results:
 *      A pointer to a static area containing the message body
 *	is returned.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

char*
RatDbGetText(Tcl_Interp *interp, int index)
{
    static char *body;		/* Static storage area */
    static int bodySize = 0;	/* Size of static storage area */
    char fname[1024];		/* Filename of message */
    FILE *messFp;		/* Message file pointer */
    int length = 0;		/* Length of header */
    int bodyLength;		/* Length of body */
    char buf[2048];		/* Temporary holding area */

    /*
     * Check the index for validity.
     */
    if (index >= numRead || index < 0) {
	Tcl_SetResult(interp, "error: the given index is invalid", TCL_STATIC);
	return NULL;
    }
    if (NULL == entryPtr[index].content[FROM]) {
	Tcl_SetResult(interp, "error: the message is deleted", TCL_STATIC);
	return NULL;
    }

    Lock(interp);

    /*
     * Read the message into an array pointed to by 'message'.
     */
    sprintf(fname, "%s/dbase/%s", dbDir, entryPtr[index].content[FILENAME]);
    if (NULL == (messFp = fopen(fname, "r"))) {
	Unlock(interp);
	Tcl_AppendResult(interp, "error opening file (for read)\"",
		fname, "\": ", Tcl_PosixError(interp), (char*)NULL);
	return NULL;
    }
    while (fgets(buf, sizeof(buf), messFp), !feof(messFp)) {
	if ('\n' == buf[0] || '\r' == buf[0]) {
	    length = ftell(messFp);
	    break;
	}
    }
    if (length == 0) {
	fseek(messFp, 0, SEEK_END);
	length = ftell(messFp);
    }
    fseek(messFp, 0, SEEK_END);
    bodyLength = ftell(messFp) - length;
    if (bodyLength+1 > bodySize) {
	ckfree(body);
	bodySize = bodyLength+1;
	body = (char*)ckalloc(bodySize);
    }
    fseek(messFp, length, SEEK_SET);
    fread(body, bodyLength, 1, messFp);
    fclose(messFp);
    body[bodyLength] = '\0';
    Unlock(interp);
    return body;
}


/*
 *----------------------------------------------------------------------
 *
 * RatDbDelete --
 *
 *      Deletes the specified entry from the database.
 *
 * Results:
 *      The return value is normally TCL_OK; if something goes wrong
 *	TCL_ERROR is returned and an error message will be left in
 *	interp->result.
 *
 * Side effects:
 *      Both the internal and the disk copy of the database are affected.
 *	Observer that if some caller has previously retrieved this entry
 *	from the database with a call to RatDbGet() the RatDbEntry
 *	obtained will be destroyed (filled with nulls).
 *
 *----------------------------------------------------------------------
 */

int
RatDbDelete(Tcl_Interp *interp, int index)
{
    char buf[1024];	/* Name of index.changes file */
    FILE *indexFP;	/* File pointer to index.changes file */

    /*
     * Check the index for validity.
     */
    if (index >= numRead || index < 0) {
	Tcl_SetResult(interp, "error: the given index is invalid", TCL_STATIC);
	return TCL_ERROR;
    }

    Lock(interp);

    sprintf(buf, "%s/index.changes", dbDir);
    if (NULL == (indexFP = fopen(buf, "a"))) {
	Tcl_AppendResult(interp, "error opening (for append)\"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	Unlock(interp);
	return TCL_ERROR;
    }
    if (0 > fprintf(indexFP, "d %d\n", index)) {
	Tcl_AppendResult(interp, "Failed to write to file \"", buf, "\"",
		(char*) NULL);
	(void)fclose(indexFP);
	Unlock(interp);
	return TCL_ERROR;
    }
    if (0 != fclose(indexFP)) {
	Tcl_AppendResult(interp, "error closing file \"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	Unlock(interp);
	return TCL_ERROR;
    }

    Sync(interp);
    Unlock(interp);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * RatDbExpunge --
 *
 *      Deletes all entries marked for deletion (status contains D).
 *
 * Results:
 *      The return value is normally TCL_OK; if something goes wrong
 *	TCL_ERROR is returned and an error message will be left in
 *	interp->result.
 *
 * Side effects:
 *      Both the internal and the disk copy of the database are affected.
 *	Observer that if some caller has previously retrieved this entry
 *	from the database with a call to RatDbGet() the RatDbEntry
 *	obtained will be destroyed (filled with nulls).
 *
 *----------------------------------------------------------------------
 */

int
RatDbExpunge(Tcl_Interp *interp)
{
    char buf[1024];	/* Name of index.changes file */
    FILE *indexFP;	/* File pointer to index.changes file */
    int index, i;

    Lock(interp);

    sprintf(buf, "%s/index.changes", dbDir);
    if (NULL == (indexFP = fopen(buf, "a"))) {
	Tcl_AppendResult(interp, "error opening (for append)\"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	Unlock(interp);
	return TCL_ERROR;
    }
    for (index=0; index < numRead; index++) {
	for (i=0; entryPtr[index].content[STATUS][i]; i++) {
	    if ('D' == entryPtr[index].content[STATUS][i]) {
		fprintf(indexFP, "d %d\n", index);
		break;
	    }
	}
    }
    if (0 != fclose(indexFP)) {
	Tcl_AppendResult(interp, "error closing file \"", buf,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	Unlock(interp);
	return TCL_ERROR;
    }

    Sync(interp);
    Unlock(interp);
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * RatDbDaysSinceExpire --
 *
 *	Finds ut how long it was since the database was expired last.
 *
 * Results:
 *	An integer which is the number of days since the database was expired.
 *	If the user has no database we return 0.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
RatDbDaysSinceExpire(Tcl_Interp *interp)
{
    struct stat sbuf;
    char buf[1024];

    /*
     * First make sure we know where the database should reside.
     */
    if (0 == dbDir) {
	Tcl_DString ds;	/* Scratch area */
	char *value;	/* Value of "dbase_dir" option */

	value = Tcl_GetVar2(interp, "option", "dbase_dir", TCL_GLOBAL_ONLY);
	if (NULL == value) {
	    Tcl_SetResult(interp, "option(dbase_dir) has no value", TCL_STATIC);
	    return TCL_ERROR;
	}
	dbDir = cpystr(Tcl_TildeSubst(interp, value, &ds));
	Tcl_DStringFree(&ds);
    }

    sprintf(buf, "%s/expired", dbDir);
    if (stat(buf, &sbuf)) {
	sprintf(buf, "%s/dbase", dbDir);
	if (stat(buf, &sbuf)) {
	    return 0;
	}
    }
    if (sbuf.st_mtime > time(NULL)) {
	return 0;
    } else {
	return (time(NULL)-sbuf.st_mtime)/(24*60*60);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * RatDbExpire --
 *
 *      Runs through the database and carries out any expiration that
 *	should be done. This routine should be called periodically.
 *
 * Results:
 *	If nothing went wrong TCL_OK is returned and in interp->result is
 *	a list containing 5 numbers {num_scanned num_delete, num_backup,
 *	num_inbox num_custom}. Otherwise TCL_ERROR is returned.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
RatDbExpire(Tcl_Interp *interp, char *infolder, char *backupDirectory)
{
    char *compressProg, *compressSuffix, *backupDir, *statusId;
    int numScan = 0, numDelete = 0, numBackup = 0, numInbox = 0, numCustom = 0;
    int i, t, len, delete, mode, fd, doBackup = 0, changed = 0, error = 0;
    int move;
    char buf[1024], buf2[1024];
    FILE *indexFP = NULL;
    time_t now = time(NULL);
    struct tm *tmPtr;
    struct stat sbuf;
    struct dirent *direntPtr;
    DIR *dirPtr;

    if (0 == isRead) {
	if (TCL_OK != Read(interp)) {
	    return TCL_ERROR;
	}
    }
    /*
     * Get file creation mode
     */
    Tcl_GetInt(interp, Tcl_GetVar2(interp, "option", "permissions",
	    TCL_GLOBAL_ONLY), &mode);
    /*
     * Make sure the inbox directory exists.
     */
    sprintf(buf, "%s/inbox", dbDir);
    if (-1 == stat(buf, &sbuf)) {
	if (mkdir(buf, DIRMODE)) {
	    Tcl_AppendResult(interp, "error creating\"", buf,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * Prepare backup
     */
    if (-1 == stat(backupDirectory, &sbuf)) {
	if (mkdir(backupDirectory, DIRMODE)) {
	    Tcl_AppendResult(interp, "error creating\"", backupDirectory,
		    "\": ", Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}
    }
    compressProg = getenv("COMPRESS");
    compressSuffix = getenv("CSUFFIX");
    backupDir = Tcl_GetVar2(interp, "option", "dbase_backup", TCL_GLOBAL_ONLY);
    if (!compressProg || !compressSuffix || !backupDir) {
	Tcl_AppendResult(interp, "Internal error: compressProg, ",
		"compressSuffix or option(dbase_backup) not defined",
		(char*) NULL);
	return TCL_ERROR;
    }

    strcpy(buf, "RatLog 2 $t(db_expire) explicit");
    Tcl_Eval(interp, buf);
    statusId = cpystr(interp->result);
    Lock(interp);
    for (i=0; !error && i < numRead; i++) {
	if (!entryPtr[i].content[FROM]) {	/* Entry deleted */
	    continue;
	}
	numScan++;
	t = atoi(entryPtr[i].content[EX_TIME]);
	if (!t || t >now) {
	    continue;
	}

	/*
	 * If we get here the entry should be expired.
	 *
	 * Currently we only handle the backup, delete and inbox actions.
	 * The rest are quitely ignored.
	 */
	delete = move = 0;
	if (!strcmp("delete", entryPtr[i].content[EX_TYPE])) {
	    delete = 1;
	    numDelete++;

	} else if (!strcmp("backup", entryPtr[i].content[EX_TYPE])) {
	    move = 1;
	    numBackup++;
	    sprintf(buf, "%s/dbase/%s", dbDir, entryPtr[i].content[FILENAME]);
	    RatGenId(NULL, interp, 0, NULL);
	    sprintf(buf2, "%s/message.%s", backupDirectory, interp->result);

	} else if (!strcmp("incoming", entryPtr[i].content[EX_TYPE])) {
	    move = 1;
	    numInbox++;
	    sprintf(buf, "%s/dbase/%s", dbDir, entryPtr[i].content[FILENAME]);
	    RatGenId(NULL, interp, 0, NULL);
	    sprintf(buf2, "%s/inbox/%s", dbDir, interp->result);

	} else if (!strncmp("custom", entryPtr[i].content[EX_TYPE], 6)) {
	    numCustom++;

	} else if (!strcmp("none", entryPtr[i].content[EX_TYPE])) {
	    continue;

	} else {
	    /*
	     * If we get here it is an unkown type and we just silently
	     * deletes it (old versions of tkrat may have generated it.
	     */
	    delete = 1;
	    numDelete++;
	}
	if (move) {
	    if (link(buf, buf2)) {
		int fdSrc, fdDst;
		/*
		 * Sigh. the files are on different filesystems. We have to
		 * copy them.
		 */
		fdSrc = open(buf, O_RDONLY);
		fdDst = open(buf, O_WRONLY|O_TRUNC|O_CREAT, mode);
		do {
		    len = read(fdSrc, buf, sizeof(buf));
		    if (0 > write(fdDst, buf, len)) {
			error = errno;
			len = 0;
		    }
		} while (len);
		close(fdSrc);
		if (close(fdDst) || error) {
		    sprintf(buf, "Failed to move to file '%s': %s", buf2, 
			    Tcl_PosixError(interp));
		    RatLog(interp, RAT_ERROR, buf, 0);
		    delete = 0;
		}
	    }
	}
	if (delete || move) {
	    if (!indexFP) {
		changed = 1;
		sprintf(buf, "%s/index.changes", dbDir);
		if (NULL == (indexFP = fopen(buf, "a"))) {
		    sprintf(interp->result, "error opening (for append)\"%s\": %s\n",
			    buf, Tcl_PosixError(interp));
		    Unlock(interp);
		    return TCL_ERROR;
		}
	    }
	    fprintf(indexFP, "d %d\n", i);
	}
    }
    if (changed) {
	fclose(indexFP);
	Sync(interp);
    }
    Unlock(interp);

    /*
     * Compress the messages in the backup directory if we have enough
     * messages to make it meaningful.
     */
    if (numBackup) {
	int chunkSize;
	char *chunk;

	chunk = Tcl_GetVar2(interp, "option", "chunksize", TCL_GLOBAL_ONLY);
	if (chunk) {
	    Tcl_GetInt(interp, chunk, &chunkSize);
	} else {
	    chunkSize = 100;
	}

	if (numBackup < chunkSize) {
	    i = 0;
	    dirPtr = opendir(backupDirectory);
	    while (0 != (direntPtr = readdir(dirPtr))) {
		if (!strncmp(direntPtr->d_name, "message", 7)) {
		    i++;
		}
	    }
	    closedir(dirPtr);
	    doBackup = (i>=chunkSize);
	} else {
	    doBackup = 1;
	}
    }
    if (doBackup) {
	Tcl_Channel backupChannel, inChannel;
	char *argv[2], *error = NULL;

	free(statusId);
	strcpy(buf, "RatLog 2 $t(packing_backup) explicit");
	Tcl_Eval(interp, buf);
	statusId = cpystr(interp->result);
	tmPtr = localtime(&now);
	sprintf(buf2, ">%s/backup_%02d%02d%02d%s", backupDirectory,
		tmPtr->tm_year+1900, tmPtr->tm_mon+1, tmPtr->tm_mday+1,
		compressSuffix);
	argv[0] = compressProg;
	argv[1] = buf2;
	if (!(backupChannel = Tcl_OpenCommandChannel(interp, 2, argv,
		TCL_STDIN))) {
	    Tcl_BackgroundError(interp);
	}
	if (backupChannel) {
	    dirPtr = opendir(backupDirectory);
	    while (!error && 0 != (direntPtr = readdir(dirPtr))) {
		if (strncmp(direntPtr->d_name, "message", 7)) {
		    continue;
		}
		sprintf(buf, "%s/%s", backupDirectory, direntPtr->d_name);
		inChannel = Tcl_OpenFileChannel(interp, buf, "r", 0);
		do {
		    len = Tcl_Read(inChannel, buf, sizeof(buf));
		    if (-1 == Tcl_Write(backupChannel, buf, len)) {
			error = Tcl_PosixError(interp);
		    }
		} while (!error && !Tcl_Eof(inChannel));
		Tcl_Close(interp, inChannel);
	    }
	    if (TCL_OK != Tcl_Close(interp, backupChannel)) {
		error = Tcl_PosixError(interp);
	    }
	    if (error) {
		unlink(buf2);
		Tcl_SetResult(interp, error, TCL_STATIC);
		Tcl_BackgroundError(interp);
	    } else {
		rewinddir(dirPtr);
		while (0 != (direntPtr = readdir(dirPtr))) {
		    if (!strncmp(direntPtr->d_name, "message", 7)) {
			sprintf(buf,"%s/%s",backupDirectory,direntPtr->d_name);
			unlink(buf);
		    }
		}
	    }
	    closedir(dirPtr);
	}
    }

    /*
     * Move messages to inbox
     */
    if (numInbox) {
	char *data = NULL, *msg, *cPtr;
	int fd, allocated = 0;

	sprintf(buf, "%s/inbox", dbDir);
	dirPtr = opendir(buf);
	while (0 != (direntPtr = readdir(dirPtr))) {
	    sprintf(buf2, "%s/%s", buf, direntPtr->d_name);
	    if (stat(buf2, &sbuf) || !S_ISREG(sbuf.st_mode)) {
		continue;
	    }
	    if (allocated < sbuf.st_size+1) {
		allocated = sbuf.st_size+1;
		data = (char*)REALLOC(data, allocated);
	    }
	    fd = open(buf2, O_RDONLY);
	    read(fd, data, sbuf.st_size);
	    close(fd);
	    data[sbuf.st_size] = '\0';
	    unlink(buf2);
	    for (cPtr = data; *cPtr != '\n'; cPtr++);
	    if (*(++cPtr) == '\r') {
		cPtr++;
	    }
	    msg = RatFrMessageCreate(interp, cPtr, sbuf.st_size, NULL);
	    if (TCL_OK == Tcl_VarEval(interp, infolder, " insert ", msg,NULL)){
		unlink(buf2);
	    }
	}
	closedir(dirPtr);
    }
    /*
     * Mark that we have done expire
     */
    sprintf(buf, "%s/expired", dbDir);
    (void)unlink(buf);
    if (0 <= (fd = open(buf, O_WRONLY|O_CREAT, mode))) {
	close(fd);
    }
    Tcl_VarEval(interp, "RatClearLog ", statusId, "; update idletasks",
	    (char*) NULL);
    free(statusId);

    /*
     * Create result list and return
     */
    Tcl_ResetResult(interp);
    sprintf(interp->result, "%d %d %d %d %d", numScan, numDelete, numBackup,
	    numInbox, numCustom);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * RatDbClose --
 *
 *      Closes the database on disk.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The rlock file is removed and some of the internal data structures
 *	are freed (but not all :-().
 *
 *----------------------------------------------------------------------
 */

void
RatDbClose()
{
    char buf[1024];	/* Scratch area */

    if (1 == isRead) {
	ckfree(entryPtr);
	isRead = 0;

	sprintf(buf, "%s/rlock.%s", dbDir, ident);
	unlink(buf);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * RatDbBuildList --
 *
 *      Builds a list of the files in the database
 *
 *	The algorithm is to open the directory and for all files do:
 *	  - If the file is ".seq" then we read it and remember the number
 *	  - If the name starts with a dot ('.') then we continue with the
 *	    next file.
 *	  - If it is a directory the we recursively call ourselves to check
 *	    that directory.
 *	  - If it is an ordinary file then we add it to the hastable (the
 *	    hash is computed from the prefix/filename). We also decode the
 *	    number of the file and remembers the highest number found.
 *	When all files are checked we check if the highest number found
 *	was bigger than the content of seq. If it is so then we
 *	  - Append a warning to interp->result
 *	  - write a new .seq file IF fix is true.
 *
 * Results:
 *	May append diagnostic messages to interp->result.
 *
 * Side effects:
 *	Will probably add items to the given hashtable.
 *
 *----------------------------------------------------------------------
 */

static void
RatDbBuildList(Tcl_Interp *interp, Tcl_DString *dsPtr, char *prefix, char *dir,
	Tcl_HashTable *tablePtr, int fix)
{
    char buf[1024], path[1024];
    int seq = -1, i;
    Tcl_HashEntry *entryPtr;
    RatDbItem *itemPtr;
    struct dirent *entPtr;
    struct stat sbuf;
    DIR *dirPtr;
    FILE *fp;

    if (NULL == (dirPtr = opendir(dir))) {
	sprintf(buf, "Failed to open directory \"%s\": %s", dir,
		Tcl_PosixError(interp));
	Tcl_DStringAppendElement(dsPtr, buf);
	return;
    }
    while (NULL != (entPtr = readdir(dirPtr))) {
	if (!strcmp(entPtr->d_name, ".seq")) {
	    sprintf(path, "%s/.seq", dir);
	    if (NULL == (fp = fopen(path, "r"))) {
		sprintf(buf, "Failed to open file \"%s\": %s", path,
			Tcl_PosixError(interp));
		Tcl_DStringAppendElement(dsPtr, buf);
		if (fix) {
		    if (unlink(path)) {
			sprintf(buf, "Failed to unlink file \"%s\": %s", path,
				Tcl_PosixError(interp));
			Tcl_DStringAppendElement(dsPtr, buf);
		    }
		}
	    } else {
		fscanf(fp, "%d", &seq);
		fclose(fp);
	    }
	}
	if ('.' == entPtr->d_name[0]) {
	    continue;
	}
	sprintf(path, "%s/%s", dir, entPtr->d_name);
	if (stat(path, &sbuf)) {
	    sprintf(buf, "Failed to stat file %s: %s\n", path,
		    Tcl_PosixError(interp));
	    Tcl_DStringAppendElement(dsPtr, buf);
	    continue;
	}
	if (S_IFREG == (sbuf.st_mode&S_IFMT)) {
	    if (!(S_IRUSR & sbuf.st_mode)) {
		sprintf(buf, "\"%s\" is not readable by the owner", path);
		Tcl_DStringAppendElement(dsPtr, buf);
		if (fix) {
		    if (chmod(path, sbuf.st_mode|S_IRUSR)) {
			sprintf(buf, "Failed to chmod \"%s\": %s", path,
				Tcl_PosixError(interp));
			Tcl_DStringAppendElement(dsPtr, buf);
			continue;
		    }
		}
	    }
	    if (0 == sbuf.st_size) {
		sprintf(buf, "Empty file \"%s\" found", path);
		if (fix) {
		    if (unlink(path)) {
			sprintf(buf, "Failed to unlink \"%s\": %s", path,
				Tcl_PosixError(interp));
			Tcl_DStringAppendElement(dsPtr, buf);
		    }
		}
		continue;
	    }
	    if (*prefix) {
		sprintf(buf, "%s/%s", prefix, entPtr->d_name);
	    } else {
		strcpy(buf, entPtr->d_name);
	    }
	    itemPtr = (RatDbItem*)malloc(sizeof(RatDbItem));
	    itemPtr->fileSize = sbuf.st_size;
	    itemPtr->index = -1;
	    for (i=0; i<RATDBETYPE_END; i++) {
		itemPtr->entry.content[i] = NULL;
	    }
	    entryPtr = Tcl_CreateHashEntry(tablePtr, buf, &i);
	    Tcl_SetHashValue(entryPtr, (ClientData)itemPtr);
	} else if (S_IFDIR == (sbuf.st_mode&S_IFMT)) {
	    if (prefix && *prefix) {
		sprintf(path, "%s/%s", prefix, entPtr->d_name);
	    } else {
		strcpy(path, entPtr->d_name);
	    }
	    sprintf(buf, "%s/%s", dir, entPtr->d_name);
	    RatDbBuildList(interp, dsPtr, path, buf, tablePtr, fix);
	} else {
	    sprintf(buf, "\"%s\" is not a file", path);
	    Tcl_DStringAppendElement(dsPtr, buf);
	}
    }
    closedir(dirPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * RatDbCheck --
 *
 *      Checks the database.
 *
 * Results:
 *	A diagnostic string.
 *
 * Side effects:
 *	The database on disk may be rewritten (depends on the fix argument).
 *
 *----------------------------------------------------------------------
 */

#define EXP_NUM		"[0-9]*"
#define EXP_TYPE	"^((none)|(remove)|(incoming)|(backup)|(custom.*))?$"
#define EXP_FILE	"[^/]+/[0-9]*"

int
RatDbCheck(Tcl_Interp *interp, int fix)
{
    int numFound = 0, numMal = 0, numAlone = 0, numUnlinked = 0, totSize = 0,
        fd, lines, start, index, i, j, extraNum = 0, extraAlloc = 0, msgLen = 0,
	date = 0, listArgc, elemArgc, indexInfo = 0;
    char buf[8092], *indexPtr = NULL, **linePtrPtr = NULL, *cPtr,
	 *to, *from, *cc, *subject, *flags, **listArgv, **elemArgv,
	 *msgBuf = NULL;
    Tcl_HashTable items, status;
    char **extraPtrPtr = NULL;
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Tcl_DString reportDS;
    RatDbItem *itemPtr;
    struct stat sbuf;
    MESSAGECACHE elt;
    struct tm tm;
    FILE *fp;

    /*
     * Initialize variables
     */
    if (0 == dbDir) {
	Tcl_DString ds;	/* Scratch area */
	char *value;	/* Value of "dbase_dir" option */

	value = Tcl_GetVar2(interp, "option", "dbase_dir", TCL_GLOBAL_ONLY);
	if (NULL == value) {
	    return TCL_OK;
	}
	dbDir = cpystr(Tcl_TildeSubst(interp, value, &ds));
	Tcl_DStringFree(&ds);
    }
    if (0 == ident) {
	gethostname(buf, sizeof(buf));
	ident = (char*)ckalloc(strlen(buf)+16);
	sprintf(ident, "%s:%d", buf, (int)getpid());
    }

    /*
     * Check that the database directory exists. If not we return zeros
     */
    if (0 > stat(dbDir, &sbuf) ||
	    !S_ISDIR(sbuf.st_mode)) {
	Tcl_SetResult(interp, "0 0 0 0 0 {}", TCL_STATIC);
	return TCL_OK;
    }


    /*
     * Lock the database. We should also check that nobody else has
     * a read lock as well.
     */
    Lock(interp);
    if (IsRlocked(NULL)) {
	Unlock(interp);
	Tcl_SetResult(interp, "Some other process has locked the database.",
		TCL_STATIC);
	return TCL_ERROR;
    }

    /*
     * Check index.info file
     */
    sprintf(buf, "%s/index.info", dbDir);
    if (NULL == (fp = fopen(buf, "r"))) {
	Tcl_DStringAppendElement(&reportDS, "Failed to open index.info file");
    } else {
	fscanf(fp, "%d %d", &i, &indexInfo);
	fclose(fp);
	if (i != 3) {
	    Tcl_DStringAppendElement(&reportDS, "Wrong version of dbase");
	    Unlock(interp);
	    return TCL_ERROR;
	}
    }

    /*
     * Initialize variables
     */
    Tcl_DStringInit(&reportDS);
    Tcl_InitHashTable(&items, TCL_STRING_KEYS);
    Tcl_InitHashTable(&status, TCL_ONE_WORD_KEYS);

    /*
     * Get a list of messages actually stored
     */
    sprintf(buf, "%s/dbase", dbDir);
    RatDbBuildList(interp, &reportDS, "", buf, &items, fix);

    /*
     * Check the changes file for flag changes and store them in the
     * status hash table.
     */
    sprintf(buf, "%s/index.changes", dbDir);
    if (NULL != (fp = fopen(buf, "r"))) {
	while (fgets(buf, sizeof(buf), fp), !feof(fp)) {
	    switch (buf[0]) {
	    case 'a':
		indexInfo++;
		break;
	    case 'd':
		indexInfo--;
		break;
	    case 's':
		if (extraNum == extraAlloc) {
		    extraAlloc += 32;
		    extraPtrPtr = (char**)REALLOC(extraPtrPtr,
			    extraAlloc*sizeof(char*));
		}
		extraPtrPtr[extraNum] = (char*)malloc(strlen(buf));
		sscanf(buf, "%*s %d %s", &index, extraPtrPtr[extraNum]);
		entryPtr = Tcl_CreateHashEntry(&status, (char*)index, &i);
		Tcl_SetHashValue(entryPtr, (ClientData)extraPtrPtr[extraNum]);
		extraNum++;
		break;
	    }
	}
	fclose(fp);
    }

    /*
     * Check the index file
     */
    sprintf(buf, "%s/index", dbDir);
    if (-1 != (fd = open(buf, O_RDONLY))) {
	/*
	 * Read file and build pointers to the lines
	 */
	fstat(fd, &sbuf);
	indexPtr = (char*)malloc(sbuf.st_size+1);
	read(fd, indexPtr, sbuf.st_size);
	close(fd);
	indexPtr[sbuf.st_size] = '\0';
	for (lines = 0, cPtr = indexPtr; *cPtr; cPtr++) {
	    if ('\n' == *cPtr) {
		lines++;
	    }
	}
	linePtrPtr = (char**)malloc(sizeof(char*)*lines);
	for (cPtr = indexPtr, i = 0; *cPtr && cPtr; i++) {
	    linePtrPtr[i] = cPtr;
	    if ((cPtr = strchr(cPtr, '\n'))) {
		*cPtr++ = '\0';
	    }
	}

	/*
	 * Now we are ready to reconstruct the index. We do this one entry
	 * a time. For each entry we read one line at a time and check the
	 * content against what we expected. We expect the following lines
	 * and contents:
	 *	to	 - any string
	 *	from	 - any string
	 *	cc	 - any string
	 *	subject	 - any string
	 *	date	 - a number
	 *	keywords - any string
	 *	size	 - a number
	 *	status	 - any string
	 *	extime	 - a number
	 *	exevent	 - one of none, remove, incoming, backup and custom
	 *	filename - (.*)/[0-9]+
	 * When we have found an index we check for the corresponding entry
	 * in the list of files and fill it in.
	 */
	for (start = index = 0; start < lines; index++) {
	    if (start > lines-11) {
		break;
	    }
	    if (!Tcl_RegExpMatch(interp, linePtrPtr[start+4], EXP_NUM)
		    || !Tcl_RegExpMatch(interp, linePtrPtr[start+6], EXP_NUM)
		    || !Tcl_RegExpMatch(interp, linePtrPtr[start+8], EXP_NUM)
		    || !Tcl_RegExpMatch(interp, linePtrPtr[start+9], EXP_TYPE)
		    || !Tcl_RegExpMatch(interp, linePtrPtr[start+10],EXP_FILE)){
		sprintf(buf, "Entry %d is malformed", index);
		Tcl_DStringAppendElement(&reportDS, buf);
		numMal++;

		/*
		 * We have found an malformed entry, first we search for the
		 * filename which should be the last item. From that we go
		 * backwards and try to collapse lines that somehow was
		 * splitted.
		 */
		i=0;
		while (!Tcl_RegExpMatch(interp,linePtrPtr[start+i],EXP_FILE)) {
		    if (start + (++i) == lines) {
			break;
		    };
		}
		i++;
		if (start+i >= lines) {
		    /*
		     * We have reached the end of the file
		     */
		    break;
		}

		/* 
		 * Here we should collapse the lines but for now we
		 * just continue with the next item. /MaF
		 */
		start += i;
		continue;

	    }
	    if (!(entryPtr = Tcl_FindHashEntry(&items, linePtrPtr[start+10]))) {
		numAlone++;
		sprintf(buf, "Entry %d has no associated file '%s'",
			index, linePtrPtr[start+10]);
		Tcl_DStringAppendElement(&reportDS, buf);
		start += 11;
		continue;
	    }
	    itemPtr = (RatDbItem*)Tcl_GetHashValue(entryPtr);
	    for (i=0; i<RATDBETYPE_END; i++, start++) {
		if (i == STATUS && (entryPtr = Tcl_FindHashEntry(&status,
			(char*)numFound))) {
		    itemPtr->entry.content[i]=(char*)Tcl_GetHashValue(entryPtr);
		} else {
		    itemPtr->entry.content[i] = linePtrPtr[start];
		}
	    }
	    numFound++;
	}
    }

    /*
     * Check for unlinked messages
     * And calculate total size while we are at it.
     */
    for (entryPtr = Tcl_FirstHashEntry(&items, &search);
	    entryPtr;
	    entryPtr = Tcl_NextHashEntry(&search)) {
	itemPtr = (RatDbItem*)Tcl_GetHashValue(entryPtr);
	totSize += itemPtr->fileSize;
	if (itemPtr->entry.content[0]) {
	    continue;
	}
	numUnlinked++;
	if (fix) {
	    /*
	     * Generate index entries for this message
	     */
	    to = from = cc = subject = flags = NULL;
	    date = 0;
	    if (extraNum+8 >= extraAlloc) {
		extraAlloc += 32;
		extraPtrPtr = (char**)REALLOC(extraPtrPtr,
			extraAlloc*sizeof(char*));
	    }
	    if (msgLen < itemPtr->fileSize+1) {
		msgLen = itemPtr->fileSize+4096;
		msgBuf = (char*)REALLOC(msgBuf, msgLen);
	    }
	    sprintf(buf, "%s/dbase/%s", dbDir, Tcl_GetHashKey(&items,entryPtr));
	    if (-1 == (fd = open(buf, O_RDONLY))) {
		continue;
	    }
	    read(fd, msgBuf, itemPtr->fileSize);
	    msgBuf[itemPtr->fileSize] = '\0';
	    close(fd);
	    if (NULL == (cPtr = strstr(msgBuf, "\n\n"))) {
		cPtr = strstr(msgBuf, "\r\n\r");
	    }
	    *(++cPtr) = '\0';
	    RatMessageGetHeader(interp, msgBuf, "full");
	    Tcl_SplitList(interp, interp->result, &listArgc, &listArgv);
	    for (i=0; i<listArgc; i++) {
		Tcl_SplitList(interp, listArgv[i], &elemArgc, &elemArgv);
		if (!to && !strcasecmp(elemArgv[0], "to")) {
		    to = extraPtrPtr[extraNum++] = cpystr(elemArgv[1]);
		} else if (!from && !strcasecmp(elemArgv[0], "from")) {
		    from = extraPtrPtr[extraNum++] = cpystr(elemArgv[1]);
		} else if (!cc && !strcasecmp(elemArgv[0], "cc")) {
		    cc = extraPtrPtr[extraNum++] = cpystr(elemArgv[1]);
		} else if (!subject && !strcasecmp(elemArgv[0], "subject")) {
		    subject = extraPtrPtr[extraNum++] = cpystr(elemArgv[1]);
		} else if (!strcasecmp(elemArgv[0], "status") ||
			   !strcasecmp(elemArgv[0], "x-status")) {
		    if (flags) {
			flags=(char*)realloc(flags,strlen(flags)+
				strlen(elemArgv[1])+1);
			strcpy(&flags[strlen(flags)], elemArgv[1]);
		    } else {
			flags = cpystr(elemArgv[1]);
		    }
		} else if (!strcasecmp(elemArgv[0], "date")) {
		    if (T == mail_parse_date(&elt, elemArgv[1])) {
			tm.tm_sec = elt.seconds;
			tm.tm_min = elt.minutes;
			tm.tm_hour = elt.hours;
			tm.tm_mday = elt.day;
			tm.tm_mon = elt.month - 1;
			tm.tm_year = elt.year+70;
			tm.tm_wday = 0;
			tm.tm_yday = 0;
			tm.tm_isdst = -1;
			date = (int)mktime(&tm);
		    } else {
			date = 0;
		    }
		}
		ckfree(elemArgv);
	    }
	    ckfree(listArgv);
	    if (flags) {
		extraPtrPtr[extraNum++] = flags;
	    }
	    itemPtr->entry.content[TO] = to ? to : "";
	    itemPtr->entry.content[FROM] = from ? from : "";
	    itemPtr->entry.content[CC] = cc ? cc : "";
	    itemPtr->entry.content[SUBJECT] = subject ? subject : "";
	    sprintf(buf, "%d", date);
	    itemPtr->entry.content[DATE] = extraPtrPtr[extraNum++] =cpystr(buf);
	    itemPtr->entry.content[KEYWORDS] = "LostMessage";
	    sprintf(buf, "%d", itemPtr->fileSize);
	    itemPtr->entry.content[RSIZE] = extraPtrPtr[extraNum++]=cpystr(buf);
	    itemPtr->entry.content[STATUS] = flags ? flags : "";
	    sprintf(buf, "%ld", time(NULL)+60*60*24*100);
	    itemPtr->entry.content[EX_TIME]=extraPtrPtr[extraNum++]=cpystr(buf);
	    itemPtr->entry.content[EX_TYPE] = "backup";
	    itemPtr->entry.content[FILENAME] = Tcl_GetHashKey(&items, entryPtr);
	}
    }
    if (numUnlinked && fix) {
	Tcl_DStringAppendElement(&reportDS,
"The unlinked messages has been inserted with the keyword 'LostMessage'");
    }
    if (indexInfo != numFound+numUnlinked) {
	if (fix) {
	    sprintf(buf, "Number of messages in index.info was wrong (was: %d is now: %d)",
		indexInfo, numFound+numUnlinked);
	} else {
	    sprintf(buf, "Number of messages in index.info is wrong (was: %d should be: %d)",
		indexInfo, numFound+numUnlinked);
	}
	Tcl_DStringAppendElement(&reportDS, buf);
    }

    /*
     * Write new index if fixing and needing
     */
    if (fix && (numMal || numAlone || numUnlinked ||
	    indexInfo != numFound+numUnlinked)) {
	sprintf(buf, "%s/index", dbDir);
	fp = fopen(buf, "w");
	for (entryPtr = Tcl_FirstHashEntry(&items, &search), j=0;
		entryPtr;
		entryPtr = Tcl_NextHashEntry(&search)) {
	    itemPtr = (RatDbItem*)Tcl_GetHashValue(entryPtr);
	    for (i=0; i<RATDBETYPE_END; i++) {
		fputs(itemPtr->entry.content[i], fp);
		fputc('\n', fp);
	    }
	    j++;
	}
	fclose(fp);
	sprintf(buf, "%s/index.info", dbDir);
	fp = fopen(buf, "w");
	fprintf(fp, "3 %d\n", j);
	fclose(fp);
	sprintf(buf, "%s/index.changes", dbDir);
	(void)unlink(buf);

	if (isRead) {
	    isRead = 0;
	    sprintf(buf, "Popup $t(need_restart)");
	    Tcl_Eval(interp, buf);
	}
    }
    
    /*
     * Cleaning up
     */
    Unlock(interp);

    for (entryPtr = Tcl_FirstHashEntry(&items, &search);
	    entryPtr;
	    entryPtr = Tcl_NextHashEntry(&search)) {
	free(Tcl_GetHashValue(entryPtr));
    }
    Tcl_DeleteHashTable(&items);
    Tcl_DeleteHashTable(&status);
    if (indexPtr) {
	free(indexPtr);
    }
    if (linePtrPtr) {
	free(linePtrPtr);
    }

    Tcl_ResetResult(interp);
    sprintf(buf, "%d", numFound);
    Tcl_AppendElement(interp, buf);
    sprintf(buf, "%d", numMal);
    Tcl_AppendElement(interp, buf);
    sprintf(buf, "%d", numAlone);
    Tcl_AppendElement(interp, buf);
    sprintf(buf, "%d", numUnlinked);
    Tcl_AppendElement(interp, buf);
    sprintf(buf, "%d", totSize);
    Tcl_AppendElement(interp, buf);
    Tcl_AppendElement(interp, Tcl_DStringValue(&reportDS));
    Tcl_DStringFree(&reportDS);
    for (i=0; i<extraNum; i++) {
	free(extraPtrPtr[i]);
    }
    free(extraPtrPtr);
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * NoLFPrint --
 *
 *      Prints the given string, but replaces any newlines with space.
 *	Also handles null strings.
 *
 * Results:
 *	-1 if any error ocurred
 *
 * Side effects:
 *	The mentioned file is modified
 *
 *----------------------------------------------------------------------
 */

static int
NoLFPrint(FILE *fp, char *s)
{
    unsigned char *cPtr;

    for (cPtr = (unsigned char*)s; cPtr && *cPtr; cPtr++) {
	if ('\n' == *cPtr) {
	    if (isspace(cPtr[1])) {
		cPtr++;
	    } else {
		fputc(' ', fp);
	    }
	} else {
	    fputc(*cPtr, fp);
	}
    }
    return fputc('\n', fp);
}