/*
 * Copyright (C) 2003  Sam Horrocks
 * 
 * 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.
 *
 */

#include "speedy.h"

/*
 * Accomodate 5.004
 */
#if PATCHLEVEL < 5
#define newSVpvn(s,l) newSVpv((l) ? (s) : "", (l))
#endif

/* For declaring xs_init prior to 5.6 */
#ifndef pTHXo
#define pTHXo void
#endif

/*
 * Prior to perl 5.6.0 these funcs were prefixed with "perl_"
 */
#ifndef get_sv
#	define get_sv perl_get_sv
#endif
#ifndef get_av
#	define get_av perl_get_av
#endif
#ifndef get_cv
#	define get_cv perl_get_cv
#endif
#ifndef get_hv
#	define get_hv perl_get_hv
#endif
#ifndef call_sv
#	define call_sv perl_call_sv
#endif
#ifndef eval_sv
#	define eval_sv perl_eval_sv
#endif
#ifndef eval_pv
#	define eval_pv perl_eval_pv
#endif
#ifndef call_pv
#	define call_pv perl_call_pv
#endif


/*
 * Convert integer to a hex-string in reverse.  Works for any number of bits
 */
#define HEX_STR_SIZE(type) (sizeof(type)*2)
#define NIB_TO_HEX(n) ("0123456789abcdef"[n])
#define HEX_CVT(i,b) \
    { \
	int cnt = HEX_STR_SIZE(i); \
	do { \
	    *(b)++ = NIB_TO_HEX((i)&15); \
	    (i) = (i) >> 4; \
	} while (i && --cnt); \
    }

#define DEVFD "/dev/fd/%d"

#define DEVINO_STR_SIZE \
	(HEX_STR_SIZE(speedy_dev_t)+HEX_STR_SIZE(speedy_ino_t)+2)
#define DEVINO_SAME(a,b) ((a).i == (b).i && (a).d == (b).d)
#define DEVINO_GET(fp,devino) PerlIO_read(fp, &(devino), sizeof(devino))
#define my_SvPV(sv) SvPV(sv, junk_len)
#define chdir_path_sv(sv) chdir_path(my_SvPV(sv), NULL)
#define my_hv_store(hash, key, klen, val) \
    do { \
	if (!hv_store((hash), (key), (klen), (val), 0)) \
	    SvREFCNT_dec(val); \
    } while (0)

typedef struct {
    int			refcnt;
    SV			*path;
    SpeedyDevIno	devino;
} SpeedyCwd;

typedef struct {
    SV		*handler;
    SpeedyCwd	*last_cwd;
} SpeedyScript;

typedef struct {
    void		*ptr;
    const svtype	type;
    const char		*name;
} SpeedyPerlVar;

extern void xs_init(pTHXo);

/* Generated by util/perlvars */

#define PERLVAR_ENV               (SpeedyPerlVars[0])
#define PERLVAL_ENV               ((HV*)(SpeedyPerlVars[0].ptr))
#define PERLVAR_ARGV              (SpeedyPerlVars[1])
#define PERLVAL_ARGV              ((AV*)(SpeedyPerlVars[1].ptr))
#define PERLVAR_STDIN             (SpeedyPerlVars[2])
#define PERLVAL_STDIN             ((GV*)(SpeedyPerlVars[2].ptr))
#define PERLVAR_STDOUT            (SpeedyPerlVars[3])
#define PERLVAL_STDOUT            ((GV*)(SpeedyPerlVars[3].ptr))
#define PERLVAR_STDERR            (SpeedyPerlVars[4])
#define PERLVAL_STDERR            ((GV*)(SpeedyPerlVars[4].ptr))
#define PERLVAR_PROGRAM_NAME      (SpeedyPerlVars[5])
#define PERLVAL_PROGRAM_NAME      ((SV*)(SpeedyPerlVars[5].ptr))
#define PERLVAR_EVAL_ERROR        (SpeedyPerlVars[6])
#define PERLVAL_EVAL_ERROR        ((SV*)(SpeedyPerlVars[6].ptr))
#define PERLVAR_RESET_GLOBALS     (SpeedyPerlVars[7])
#define PERLVAL_RESET_GLOBALS     ((CV*)(SpeedyPerlVars[7].ptr))
#define PERLVAR_OPTS_CHANGED      (SpeedyPerlVars[8])
#define PERLVAL_OPTS_CHANGED      ((SV*)(SpeedyPerlVars[8].ptr))
#define PERLVAR_OPTS              (SpeedyPerlVars[9])
#define PERLVAL_OPTS              ((HV*)(SpeedyPerlVars[9].ptr))
#define PERLVAR_RUN_SHUTDOWN      (SpeedyPerlVars[10])
#define PERLVAL_RUN_SHUTDOWN      ((CV*)(SpeedyPerlVars[10].ptr))
#define PERLVAR_SUB               (SpeedyPerlVars[11])
#define PERLVAL_SUB               ((SV*)(SpeedyPerlVars[11].ptr))
#define PERLVAR_I_AM_SPEEDY       (SpeedyPerlVars[12])
#define PERLVAL_I_AM_SPEEDY       ((SV*)(SpeedyPerlVars[12].ptr))
#define PERLVAR_RUN_CLEANUP       (SpeedyPerlVars[13])
#define PERLVAL_RUN_CLEANUP       ((CV*)(SpeedyPerlVars[13].ptr))
#define PERLVAR_FORK              (SpeedyPerlVars[14])
#define PERLVAL_FORK              ((CV*)(SpeedyPerlVars[14].ptr))
#define PERLVAR_COUNT             15

static SpeedyPerlVar SpeedyPerlVars[] = {
    {NULL, SVt_PVHV , "ENV"},
    {NULL, SVt_PVAV , "ARGV"},
    {NULL, SVt_PVIO , "STDIN"},
    {NULL, SVt_PVIO , "STDOUT"},
    {NULL, SVt_PVIO , "STDERR"},
    {NULL, SVt_PV   , "0"},
    {NULL, SVt_PV   , "@"},
    {NULL, SVt_PVCV , "CGI::_reset_globals"},
    {NULL, SVt_IV   , SPEEDY_PKG("_opts_changed")},
    {NULL, SVt_PVHV , SPEEDY_PKG("_opts")},
    {NULL, SVt_PVCV , SPEEDY_PKG("_run_shutdown")},
    {NULL, SVt_PV   , SPEEDY_PKG("_sub")},
    {NULL, SVt_IV   , SPEEDY_PKG("i_am_speedy")},
    {NULL, SVt_PVCV , SPEEDY_PKG("_run_cleanup")},
    {NULL, SVt_PVCV , SPEEDY_PKG("_fork")},
};

/* End of generated section */

static const char 	*dev_null = "/dev/null";

PerlInterpreter		*my_perl;
static int		cwd_fd = -1;
static STRLEN		junk_len;
static HV		*cwd_hash, *scr_hash;
static const int	caught_sigs[] = {SIGTERM, SIGHUP, SIGINT};


#define NUMSIGS (sizeof(caught_sigs) / sizeof(int))

/*
 * Stuff to be stashed in cwd_hash / scr_hash
 *
 * %cwd{$devino_str} = SpeedyCwd*
 * %cwd{$path} = SpeedyCwd*
 * %script{$devino_str} = SpeedyScript*
 */

static int devino_str(SpeedyDevIno devino, char str[DEVINO_STR_SIZE]) {
    char *bp = str;
    speedy_ino_t i = devino.i;
    speedy_dev_t d = devino.d;

    HEX_CVT(i, bp)
    *bp++ = '_';
    HEX_CVT(d, bp)
    *bp = '\0';
    return bp - str;
}

/*
 * Debugging code to dump out the internal hashes - cwd_hash and scr_hash
 */

#ifdef DUMP_HASH

#define PRINTABLE(s) ((s) ? (s) : "NULL")

static void dump_cwd(SpeedyCwd *cwd, PerlIO *pio) {
    char dino_str[DEVINO_STR_SIZE];

    devino_str(cwd->devino, dino_str);
    PerlIO_printf(pio, "{refcnt=%d, path=%s, devino=%s}",
	cwd->refcnt, PRINTABLE(my_SvPV(cwd->path)), dino_str
    );
}

static void dump_hash(HV *hv, PerlIO *pio) {
    SV *sv;
    char *key;

    PerlIO_printf(pio, "Dump of %s_hash\n", hv == cwd_hash ? "cwd" : "script");
    hv_iterinit(hv);
    while ((sv = hv_iternextsv(hv, &key, &junk_len))) {
	PerlIO_printf(pio, "%s=", key);
	if (hv == scr_hash) {
	    SpeedyScript *scr = (SpeedyScript*)SvIV(sv);

	    PerlIO_printf(pio, "{handler=%x, last_cwd=", (int)(scr->handler));
	    if (scr->last_cwd)
		dump_cwd(scr->last_cwd, pio);
	    else
		PerlIO_printf(pio, "NULL");
	    PerlIO_printf(pio, "}\n");
	} else {
	    SpeedyCwd * cwd = (SpeedyCwd*)SvIV(sv);
	    dump_cwd(cwd, pio);
	    PerlIO_printf(pio, "\n");
	}
    }
}

#endif /* DUMP_HASH */

/* Locate a devino in one of the hashes */
static SV **find_devino(SpeedyDevIno devino, HV *hash, int lval) {
    char key[DEVINO_STR_SIZE];
    int key_len;

    key_len = devino_str(devino, key);
    return hv_fetch(hash, key, key_len, lval);
}

/* Find the SpeedyScript structure in the hash, using a devino key
 * Create a new one if not found.
 */
static SpeedyScript *find_scr(SpeedyDevIno devino, int *is_new) {
    SV *sv;
    SpeedyScript *retval;

    sv = find_devino(devino, scr_hash, 1)[0];

    if ((*is_new = !SvOK(sv))) {
	speedy_new(retval, 1, SpeedyScript);
	retval->handler = NULL;
	retval->last_cwd = NULL;
	sv_setiv(sv, (IV) retval);
    } else {
	retval = (SpeedyScript *) SvIV(sv);
    }

    return retval;
}

/* Get the directory that holds the filename */
static char *fname_dir(const char *p) {
    char *s;

    if (p && (s = strrchr(p, '/')))
	return speedy_util_strndup(p, max(1,s-p));
    else
	return NULL;
}

static void my_call_sv(SV *sv) {
    if (sv) {
	dSP;
	PUSHMARK(SP);
	call_sv(sv, G_DISCARD | G_NOARGS);
    }
}

static void cwd_refcnt_dec(SpeedyCwd *cwd) {
    if (!--(cwd->refcnt)) {
	char key[DEVINO_STR_SIZE];
	int key_len;

	key_len = devino_str(cwd->devino, key);
	hv_delete(cwd_hash, key, key_len, G_DISCARD);

	hv_delete_ent(cwd_hash, cwd->path, G_DISCARD, 0);
	SvREFCNT_dec(cwd->path);
	speedy_free(cwd);
    }
}

static int stat_cwd_fd(SpeedyDevIno *devino) {
    struct stat stbuf;

    if (cwd_fd != -1) {
	if (fstat(cwd_fd, &stbuf) != -1) {
	    *devino = speedy_util_stat_devino(&stbuf);
	    return 1;
	}
	close(cwd_fd);
	cwd_fd = -1;
    }
    return 0;
}

static int chdir_path(const char *path, SpeedyDevIno *devino) {
    int retval;

    if (!path || !path[0])
	return 0;

    if (cwd_fd != -1)
	close(cwd_fd);
    retval = path
	? (((path[0] == '.' && path[1] == '\0')) ? 0 : chdir(path))
	: -1;
    cwd_fd = retval != -1
	? speedy_util_pref_fd(open(".", O_RDONLY), PREF_FD_CWD)
	: -1;
    
    if (cwd_fd != -1)
	fcntl(cwd_fd, F_SETFD, FD_CLOEXEC);

    /* TEST - simulate unreadable "." directory */
    /* close(cwd_fd); cwd_fd = -1; */
    
    /* Get device/inode for "." */
    if (retval != -1 && devino && !stat_cwd_fd(devino)) {
	struct stat stbuf;

	if (cwd_fd == -1) {
	    if (stat(".", &stbuf) == -1) {
		devino->d = 0;
		devino->i = 0;
	    }
	} else {
	    *devino = speedy_util_stat_devino(&stbuf);
	}
    }
    return retval;
}

static int quick_cd(SpeedyDevIno dest) {
    SpeedyDevIno devino;

    /*
     * See if cwd_fd is the correct dir - if so fchdir there.
     */
    if (stat_cwd_fd(&devino) && DEVINO_SAME(dest, devino) &&
	fchdir(cwd_fd) != -1)
    {
	return 1;
    }

    /* Stat "." */
    chdir_path(".", &devino);

    /* See if "." is the right directory */
    return DEVINO_SAME(dest, devino);
}

static void *get_perlvar(SpeedyPerlVar *pv) {
    if (!pv->ptr) {
	switch(pv->type) {
	    case SVt_PVIO:
		pv->ptr = gv_fetchpv(pv->name, 1, SVt_PVIO);
		break;
	    case SVt_PVAV:
		pv->ptr = get_av(pv->name, 1);
		break;
	    case SVt_PVHV:
		pv->ptr = get_hv(pv->name, 1);
		break;
	    case SVt_PVCV:
		pv->ptr = get_cv(pv->name, 0);
		break;
	    default:
		pv->ptr = get_sv(pv->name, 1);
		break;
	}
	if (pv->type != SVt_PVCV && !pv->ptr)
	    DIE_QUIET("Cannot create perl variable %s", pv->name);
    }
    return pv->ptr;
}

/* Shutdown and exit. */
static void all_done(void) {
    speedy_file_set_state(FS_CLOSED);

    /* Destroy the interpreter */
    if (my_perl) {

	/* Call any shutdown functions */
	my_call_sv(get_perlvar(&PERLVAR_RUN_SHUTDOWN));

	perl_destruct(my_perl);
    }
    speedy_util_exit(0,0);
}

/* Wait for a connection from a frontend */
static void backend_accept(void) {
    SigList sl;
    int ok;

    /* Set up caught/unblocked signals to exit on */
    speedy_sig_init(&sl, caught_sigs, NUMSIGS, SIG_UNBLOCK);

    /* Wait for an accept or timeout */
    ok = speedy_ipc_accept(OPTVAL_TIMEOUT*1000);

    /* Put signals back to original settings */
    speedy_sig_free(&sl);

    /* If timed out or signal, then finish up */
    if (!ok)
	all_done();
}

/* Read in a string on stdin. */
static char *get_string(register PerlIO *pio_in, int *sz_ret) {
    int sz;
    register char *buf;

    /* Read length of string */
    sz = PerlIO_getc(pio_in);

    switch(sz) {
    case -1:
	DIE_QUIET("protocol error");
    case 0:
	buf = NULL;
	break;
    case MAX_SHORT_STR:
	PerlIO_read(pio_in, &sz, sizeof(int));
	/* Fall through */
    default:
	/* Allocate space */
	speedy_new(buf, sz+1, char);

	/* Read string and terminate */
	PerlIO_read(pio_in, buf, sz);
	buf[sz] = '\0';
	break;
    }
    if (sz_ret)
	*sz_ret = sz;
    return buf;
}

static void do_proto2(char **cwd_path) {
    char c;

    /* Tell the frontend what we need */
    c = cwd_path ? 1 : 0;
    write(PREF_FD_ACCEPT_O, &c, 1);

    if (cwd_path) {
	PerlIO *pio_file = PerlIO_fdopen(dup(PREF_FD_ACCEPT_E), "r");

	/* Get cwd */
	*cwd_path = get_string(pio_file, NULL);

	PerlIO_close(pio_file);
    }
}

static SpeedyCwd *cwd_new(const char *path) {
    char key[DEVINO_STR_SIZE];
    int key_len;
    SV *sv;
    SpeedyCwd *cwd;
    
    speedy_new(cwd, 1, SpeedyCwd);

    /* Chdir to the given path */
    if (!path || chdir_path(path, &(cwd->devino)) == -1) {
	speedy_free(cwd);
	return NULL;
    }

    /* Make a new cwd structure */
    cwd->refcnt = 0;
    cwd->path = newSVpv(path, 0);

    /* Store in the hash */
    sv = newSViv((IV)cwd);
    SvREFCNT_inc(sv);

    key_len = devino_str(cwd->devino, key);
    my_hv_store(cwd_hash, key, key_len, sv);

    if (!hv_store_ent(cwd_hash, cwd->path, sv, 0))
	SvREFCNT_dec(sv);

    return cwd;
}

static void store_last_cwd(SpeedyCwd **last_cwd, SpeedyCwd *cwd) {
    SpeedyCwd *prev_ptr = *last_cwd;

    cwd->refcnt++;
    *last_cwd = cwd;
    if (prev_ptr)
	cwd_refcnt_dec(prev_ptr);
}

#define PACKAGE_FMT	SPEEDY_PKG("_%s")
#define COLON_HANDLER	"::handler"
#define PACKAGE1      "package "
#define PACKAGE2      "; sub handler { "

static void load_script(
    SpeedyDevIno devino, SpeedyScript *scr, const char *scr_path
)
{
    SV *sv;
    char pkg[sizeof(PACKAGE_FMT)+DEVINO_STR_SIZE+sizeof(COLON_HANDLER)+5];

    /* Get package name */
    {
	char hex_str[DEVINO_STR_SIZE];
	devino_str(devino, hex_str);
	sprintf(pkg, PACKAGE_FMT, hex_str);
    }

    /* Create phony package in sv with the script code in the handler func */
    {
	struct stat stbuf;
	SpeedyMapInfo *mi = NULL;
	int fd;

	/* Grab the contents of the file */
	if ((fd = speedy_util_open_stat(scr_path, &stbuf)) != -1) {
	    mi = speedy_util_mapin(fd, -1, stbuf.st_size);
	    close(fd);
	}
	if (fd == -1 || mi == NULL)
	    speedy_util_die(scr_path);

	/* Create sv to eval */
        sv = newSVpvn(PACKAGE1, sizeof(PACKAGE1)-1);
        sv_catpv (sv, pkg);
        sv_catpvn(sv, PACKAGE2, sizeof(PACKAGE2)-1);
	sv_catpvn(sv, mi->addr, mi->maplen);
	sv_catpvn(sv, "; }", 3);

	/* Get rid of the file contents */
	speedy_util_mapout(mi);
    }

    /* Evaluate the sv to create the handler */
    {
	dSP;
	PUSHMARK(SP);
	eval_sv(sv, G_DISCARD | G_NOARGS | G_VOID | G_EVAL | G_KEEPERR);
    }
    SvREFCNT_dec(sv);

    /* If there were no eval errors, then store a reference to the handler  */
    scr->handler = NULL;
    if (!SvTRUE(PERLVAL_EVAL_ERROR)) {
	CV *cv;
	strcat(pkg, COLON_HANDLER);
	if ((cv = get_cv(pkg, 0)))
	    scr->handler = newRV_inc((SV*)cv);
    }

    /* Die if we couldn't create the handler for whatever reason */
    if (!scr->handler) {
	DIE_QUIET("Could not compile code for %s: %s",
	    scr_path, my_SvPV(PERLVAL_EVAL_ERROR));
    }
}

static void cleanup_after_perl(void) {

    /* Cached time is now invalid */
    speedy_util_time_invalidate();

    /* Cancel any alarms */
    alarm(0);

    /* Terminate if a forked child returned */
    if (getpid() != speedy_util_getpid()) {
	speedy_util_pid_invalidate();
	speedy_file_fork_child();
	all_done();
    }

    /* Tell our file code that its fd is suspect */
    speedy_file_fd_is_suspect();
}

/* One run of the perl process, do stdio using socket. */
static int onerun(int single_script) {
    int sz, new_script, cwd_where, exit_val;
    char *scr_path;
    SpeedyDevIno fe_scr;
    SpeedyScript *scr;
    PerlIO *pio_in, *pio_out, *pio_err;
    register char *s, *buf;

    pio_in  = PerlIO_stdin();
    pio_out = PerlIO_stdout();
    pio_err = PerlIO_stderr();

    /* Set up perl STD* filehandles to have the PerlIO file pointers */
    IoIFP(GvIOp(PERLVAL_STDIN))  = IoOFP(GvIOp(PERLVAL_STDIN))  = pio_in;
    IoIFP(GvIOp(PERLVAL_STDOUT)) = IoOFP(GvIOp(PERLVAL_STDOUT)) = pio_out;
    IoIFP(GvIOp(PERLVAL_STDERR)) = IoOFP(GvIOp(PERLVAL_STDERR)) = pio_err;

    /* Do "select STDOUT" */
    setdefout(PERLVAL_STDOUT);

    /* TEST - this should cause a "protocol error" */
    /* close(0); */

    /* Get info from the frontend. */

    /*
     * %ENV
     */

    /* Undef it */
    hv_undef(PERLVAL_ENV);

    /* Read in environment from stdin. */
    while ((buf = get_string(pio_in, &sz))) {

	/* Find equals. Store key/val in %ENV */
	if ((s = strchr(buf, '='))) {
	    register int i = s - buf;
	    register int len = sz - (i+1);
	    SV *sv = newSVpvn(s+1, len);
	    my_hv_store(PERLVAL_ENV, buf, i, sv);
	    *s = '\0';
	    my_setenv(buf, s+1);
	}
	speedy_free(buf);
    }

    /*
     * @ARGV
     */

    /* Undef it. */
    av_undef(PERLVAL_ARGV);

    /* Read in argv from stdin. */
    while ((buf = get_string(pio_in, &sz))) {
	register SV *sv = newSVpvn(buf, sz);
	av_push(PERLVAL_ARGV, sv);
	speedy_free(buf);
    }

    /*
     * Script filename
     */
    scr_path = get_string(pio_in, NULL);

    /*
     * Script device/inode
     */
    DEVINO_GET(pio_in, fe_scr);

    /*
     * Find the script structure for this script
     */
    scr = find_scr(fe_scr, &new_script);

    /*
     * Is cwd part of the script filename?
     */
    cwd_where = PerlIO_getc(pio_in);
    if (cwd_where == SPEEDY_CWD_IN_SCRIPT) {
	char *dir;

	/* Get directory from the script path */
	if ((dir = fname_dir(scr_path))) {
	    SV **sv;
	    int done = 0;
	    SpeedyCwd *cwd = NULL;
	    
	    /* Look up path in hash to find SpeedyCwd and device/inode */
	    if ((sv = hv_fetch(cwd_hash, dir, strlen(dir), 0))) {
		cwd = (SpeedyCwd*)SvIV(*sv);
		
		/* Try to cd there quickly without using a path */
		done = quick_cd(cwd->devino);
	    }
	    if (!done) {
		/* Chdir to the path the frontend gave us and get its cwd */
		cwd = cwd_new(dir);
	    }

	    /* Store the cwd struct with this script */
	    store_last_cwd(&(scr->last_cwd), cwd);
	    speedy_free(dir);
	}
    } else {
	int did_proto2 = 0, done = 0;
	SpeedyCwd *cwd = NULL;

	/* Is frontend passing over cwd's device/inode */
	if (cwd_where == SPEEDY_CWD_DEVINO) {
	    SpeedyDevIno fe_cwd;

	    /* Get cwd device/inode from frontend */
	    DEVINO_GET(pio_in, fe_cwd);

	    /* Try to quickly get there without using a path */
	    done = quick_cd(fe_cwd);

	    if (!done) {
		/* Try using the path in last_cwd in the script struct */
		done = scr->last_cwd &&
		    DEVINO_SAME(fe_cwd, scr->last_cwd->devino) &&
		    chdir_path_sv(scr->last_cwd->path) != -1;

		/* Didn't work.  Try to look up device/inode in hash */
		if (!done) {
		    SV **sv;

		    if ((sv = find_devino(fe_cwd, cwd_hash, 0))) {
			cwd = (SpeedyCwd*)SvIV(*sv);

			/* If found, go to that path */
			done = (chdir_path_sv(cwd->path) != -1);
		    }
		}
	    }
	}
	if (!done) {
	    char *dir;
	    /*
	     * Do proto2 with frontend to get path
	     */
	    do_proto2(&dir);
	    did_proto2 = 1;
	    
	    /* Cd to this path and get its cwd structure back */
	    if (dir) {
		cwd = cwd_new(dir);
		speedy_free(dir);
	    }
	}

	/* If we used a cwd structure, make sure to save it */
	if (cwd)
	    store_last_cwd(&(scr->last_cwd), cwd);

	/* Must do proto2 if not already done */
	if (!did_proto2)
	    do_proto2(NULL);
    }

    /* Do shutdowns so we get an error when writing/reading in the wrong
     * direction
     */
    shutdown(0, 1);
    shutdown(1, 0);
    shutdown(2, 0);

    /*
     * Load the script if it's new
     */
    if (new_script)
	load_script(fe_scr, scr, scr_path);

    /* Set $0 to the script filename */
    sv_setpv(PERLVAL_PROGRAM_NAME, scr_path);
    speedy_free(scr_path);

    /* If using groups, set the pointer to the correct handler */
    if (!single_script)
	sv_setsv(PERLVAL_SUB, scr->handler);

    /* Run the perl code.
     */
    exit_val = perl_run(my_perl);

    /* Call any registered cleanup functions */
    my_call_sv(get_perlvar(&PERLVAR_RUN_CLEANUP));

    cleanup_after_perl();

    /* Flush output, in case perl's stdio/reopen below don't */
    PerlIO_flush(pio_out);
    PerlIO_flush(pio_err);

    /* Close down perl's STD* files (might not be the same as PerlIO files) */
    do_close(PERLVAL_STDOUT, FALSE);
    do_close(PERLVAL_STDERR, FALSE);
    do_close(PERLVAL_STDIN,  FALSE);

    /* Get stdio files back in shape */
    if (PerlIO_reopen(dev_null, "r", pio_in ) == NULL ||
	PerlIO_reopen(dev_null, "w", pio_out) == NULL ||
	PerlIO_reopen(dev_null, "w", pio_err) == NULL)
    {
	speedy_util_die("Cannot open /dev/null");
    }
    close(0); close(1); close(2);

    /* Hack for CGI.pm */
    my_call_sv(get_perlvar(&PERLVAR_RESET_GLOBALS));

    /* Copy option values in from the perl vars */
    if (SvIV(PERLVAL_OPTS_CHANGED)) {
	int i;
	for (i = 0; i < SPEEDY_NUMOPTS; ++i) {
	    OptRec *o = speedy_optdefs + i;
	    SV **svp = hv_fetch(PERLVAL_OPTS, o->name, o->name_len, 0);
	    if (svp)
		(void) speedy_opt_set(o, my_SvPV(*svp));
	}
	sv_setiv(PERLVAL_OPTS_CHANGED, 0);
    }

#ifdef DUMP_HASH
    {
	time_t t;

	PerlIO *pio = PerlIO_open("/tmp/speedy_backend_dump", "a");
	t = time(NULL);
	PerlIO_printf(pio, "\npid=%d time=%s\n",
	    speedy_util_getpid(), asctime(localtime(&t)));
	dump_hash(cwd_hash, pio);
	dump_hash(scr_hash, pio);
	PerlIO_close(pio);
    }
#endif

    return exit_val;
}


/* Called from xs_init */
void speedy_xs_init(void) {
    int i;
    SV *sv;

    /*
     * Put things here that have to be done in the perl interpreter before
     * a script runs its BEGIN block.
     */

    /* Find/create our perl vars in the interpreter */
    for (i = 0; i < PERLVAR_COUNT; ++i) {
	(void) get_perlvar(SpeedyPerlVars + i);
    }
    scr_hash = newHV();
    cwd_hash = newHV();

    /* Tell our module that we are speedycgi */
    sv_inc(PERLVAL_I_AM_SPEEDY);

    /* Avoid warnings about "used only once" */
    GvMULTI_on(
	gv_fetchpv(PERLVAR_I_AM_SPEEDY.name, 0, PERLVAR_I_AM_SPEEDY.type)
    );

    /*
     * Initialize options variables in our module.
     */
    for (i = 0; i < SPEEDY_NUMOPTS; ++i) {
	OptRec *o = speedy_optdefs + i;
	if (o->type == OTYPE_STR) {
	    if (!STR_OPTVAL(o))
		continue;
	    sv = newSVpv(STR_OPTVAL(o), 0);
	} else {
	    sv = newSViv(INT_OPTVAL(o));
	}
	my_hv_store(PERLVAL_OPTS, o->name, o->name_len, sv);
    }
}

void speedy_perl_init(void) {
    char **perl_argv;
    const char *temp_script_name;
    int use_devfd, is_new;
    char dev_fd_name[sizeof(DEVFD)+10];
    SpeedyScript *scr;
    int single_script = DOING_SINGLE_SCRIPT;

    /* If we're exec'ing a setuid script then we must use a temporary
     * script name of /dev/fd/N 
     */
    use_devfd = single_script &&
                speedy_script_getstat()->st_mode & (S_ISUID|S_ISGID);

    if (single_script) {
	if (use_devfd) {
	    sprintf(dev_fd_name, DEVFD, speedy_script_open());
	    temp_script_name = dev_fd_name;
	} else {
	    temp_script_name = NULL;
	}
    } else {
	temp_script_name = "-e&{$" SPEEDY_PKG("_sub") "}(@ARGV);";
    }

    /* Parse perl file. */
    perl_argv = speedy_opt_perl_argv(temp_script_name);
    if (perl_parse(my_perl, xs_init,
	speedy_util_argc((const char * const *)perl_argv), perl_argv, NULL))
    {
	DIE_QUIET("perl_parse error");
    }
    cleanup_after_perl();

    /* If we had to use /dev/fd/N, perl will close the file for us, so
     * make sure our code knows it's closed.  If we need it from here on out
     * it'll have to be re-opened.
     */
    if (use_devfd)
	speedy_script_close();

    /* Create a SpeedyScript entry for the standard script */
    scr = find_scr(speedy_util_stat_devino(speedy_script_getstat()), &is_new);

    /* If using groups, try pre-loading the script to save time later */
    if (!single_script && !speedy_script_open_failure()) {
	load_script(
	    speedy_util_stat_devino(speedy_script_getstat()),
	    scr, speedy_opt_script_fname()
	);
	cleanup_after_perl();
    }

    /* Time to close stderr */
    close(2);
}

void speedy_perl_run(slotnum_t gslotnum, slotnum_t bslotnum) {
    int numrun, exit_val;
    int single_script = DOING_SINGLE_SCRIPT;

    /* Start listening on our socket */
    speedy_ipc_listen(bslotnum);

    /* Main loop */
    for (numrun = 0; !OPTVAL_MAXRUNS || numrun < OPTVAL_MAXRUNS; ++numrun) {

	/* Lock/mmap our temp file.  If our group is invalid, exit quietly */
	if (getppid() == 1 || !speedy_group_lock(gslotnum))
	    all_done();

	/* Update our maturity level */
	FILE_SLOT(be_slot, bslotnum).maturity = numrun ? 2 : 1;

	/* Put ourself onto the be_wait list */
	speedy_backend_be_wait_put(gslotnum, bslotnum);

	/* If we were listed as starting, turn that off */
	if (FILE_SLOT(gr_slot, gslotnum).be_starting == speedy_util_getpid())
	    FILE_SLOT(gr_slot, gslotnum).be_starting = 0;

	/* Send out alarm signal to frontends */
	speedy_group_sendsigs(gslotnum);

	/* Fix our listener fd */
	speedy_ipc_listen_fixfd(bslotnum);

	/* Unlock file */
	speedy_file_set_state(FS_HAVESLOTS);

	/* Do an accept on our socket */
	backend_accept();

	/* Lock file.  If our group is invalid, exit quietly */
	if (!speedy_group_lock(gslotnum))
	    all_done();

	/* If we were listed as starting, turn that off */
	if (FILE_SLOT(gr_slot, gslotnum).be_starting == speedy_util_getpid())
	    FILE_SLOT(gr_slot, gslotnum).be_starting = 0;

	/* Wake up any waiting frontends */
	speedy_group_sendsigs(gslotnum);

	/* Unlock the file */
	speedy_file_set_state(FS_HAVESLOTS);

	/* Run the perl code once */
	exit_val = onerun(single_script);

	/* Send the exit status to the frontend */
	speedy_file_set_state(FS_CORRUPT);
	speedy_backend_exited(bslotnum, 0, exit_val);
    }
    
    /* Start up a replacement backend */
    if (speedy_group_lock(gslotnum))
	speedy_group_start_be(gslotnum);

    /* Exit out */
    all_done();
}

int speedy_perl_fork(void) {
    dSP;
    int retval;
    static int made_sub;

    if (!made_sub) {
	made_sub = 1;
	eval_pv("sub " SPEEDY_PKG("_fork") " {return fork;}", TRUE);
    }

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    if (call_sv(get_perlvar(&PERLVAR_FORK), G_NOARGS|G_SCALAR) != 1)
	DIE_QUIET("perl fork didn't return one value");

    SPAGAIN;
    retval = POPi;
    PUTBACK;

    FREETMPS;
    LEAVE;

    return retval;
}

/*
 * Glue
 */

void speedy_abort(const char *s) {
    PerlIO_puts(PerlIO_stderr(), s);
    speedy_util_exit(1, 0);
}
