0.9.9e/tcl/unix.c

/*
        The Malete project - the Z39.2/Z39.50 database framework of OpenIsis.
        Version 0.9.x (patchlevel see file Version)
        Copyright (C) 2001-2004 by Erik Grziwotz, erik@openisis.org

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

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

        You should have received a copy of the GNU Lesser General Public
        License along with this library; if not, write to the Free Software
        Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

        see README for more information
EOH */

/*
        $Id: unix.c,v 1.7 2004/09/29 16:35:11 kripke Exp $
        malete unix utilities for Tcl
*/

/* #include <tclInt.h> */
#include <tcl.h>
/* #include <tclInt.h> tclByteArrayType */
extern Tcl_ObjType tclByteArrayType;

#include <sys/types.h>
#include <sys/mman.h>
#include <sys/stat.h>
#include <sys/wait.h>
#include <sys/sendfile.h>
#include <unistd.h>
#include <fcntl.h>
#include <string.h> /* memcmp :( */
#include <dlfcn.h> /* avoid -lcrypt; -ldl we have anyway */

#if defined( __sparc__ ) || defined( __ppc__ )
#       define CPU_BIG_ENDIAN
#endif

/*
        lockf channel ?mode ?nowait??
        lock complete file like flock, but based on fcntl/lockf
        mode is: unlock, shared or exclusive (or unique abbr.)
        defaults to exclusive, if channel is writable, shared else
*/
static int lockfCmd (
        ClientData ignore, Tcl_Interp *ip, int objc, Tcl_Obj* const objv[]
) {
        static const char *modenames[] = {"unlock", "shared", "exclusive", 0};
        static const short l_type[] = {F_UNLCK, F_RDLCK, F_WRLCK};
        ClientData fd;
        int mode, isopen;
        struct flock fl;
        char *name;
        Tcl_Channel chan;

        (void)ignore;
        switch (objc) {
        case 2:
        case 3:
        case 4:
                chan = Tcl_GetChannel(ip, name = Tcl_GetString(objv[1]), &isopen);
                if ( !chan
                        || (TCL_OK != Tcl_GetChannelHandle(chan, TCL_READABLE, &fd))
                ) {
                        Tcl_AppendResult (ip, "bad channel: ", name, 0);
                        return TCL_ERROR;
                }
                if ( 2 == objc )
                        mode = (TCL_WRITABLE & isopen) ? 2 : 1;
                else if ( TCL_OK !=
                        Tcl_GetIndexFromObj(ip, objv[2], modenames, "locking mode", 0, &mode)
                )
                        return TCL_ERROR;
                fl.l_type   = l_type[mode];
                fl.l_whence = SEEK_SET;
                fl.l_start  = 0;
                fl.l_len    = 0;
                Tcl_SetIntObj(Tcl_GetObjResult(ip),
                        -1 != fcntl((int)fd, (4==objc) ? F_SETLK : F_SETLKW, &fl));
                return TCL_OK;
        }
        Tcl_AppendResult(ip, "usage: ", Tcl_GetString(objv[0]),
                " channel ?mode ?nowait??", 0);
        return TCL_ERROR;
}       /* lockfCmd */


/*
        sendfile tochannel fromchannel ?offset ?len??
*/
static int sendfileCmd (
        ClientData ignore, Tcl_Interp *ip, int objc, Tcl_Obj* const objv[]
) {
        ClientData infd, outfd;
        int isopen, off = 0, len = 0;
        Tcl_Channel chan;

        (void)ignore;
        switch (objc) {
        case 5:
                if ( TCL_OK != Tcl_GetIntFromObj(ip, objv[4], &len) ) return TCL_ERROR;
        case 4:
                if ( TCL_OK != Tcl_GetIntFromObj(ip, objv[3], &off) ) return TCL_ERROR;
        case 3:
                if ( !(chan = Tcl_GetChannel(ip, Tcl_GetString(objv[2]), &isopen))
                        || !(TCL_READABLE & isopen)
                        || (TCL_OK != Tcl_GetChannelHandle(chan, TCL_READABLE, &infd))
                ) {
                        Tcl_SetResult (ip, "not readable", TCL_STATIC);
                        return TCL_ERROR;
                }
                if ( !(chan = Tcl_GetChannel(ip, Tcl_GetString(objv[1]), &isopen))
                        || !(TCL_WRITABLE & isopen)
                        || (TCL_OK != Tcl_GetChannelHandle(chan, TCL_WRITABLE, &outfd))
                ) {
                        Tcl_SetResult (ip, "not writable", TCL_STATIC);
                        return TCL_ERROR;
                }
                if ( !len ) {
                        struct stat st;
                        if ( fstat((int)infd, &st) ) {
                                Tcl_SetResult (ip, "not statable", TCL_STATIC);
                                return TCL_ERROR;
                        }
                        if ( off >= st.st_size )
                                return TCL_OK;
                        len = st.st_size - off;
                }
                Tcl_SetIntObj(Tcl_GetObjResult(ip), 
                        (int)sendfile((int)outfd, (int)infd, (off_t*)&off, (size_t)len));
                return TCL_OK;
        }
        Tcl_AppendResult(ip, "usage: ", Tcl_GetString(objv[0]),
                " tochannel fromchannel ?offset ?len??", 0);
        return TCL_ERROR;
}       /* sendfileCmd */


/*
        fork [command] [options ...]
        command:
                child (default): fork
                numchilds: return number of childs
                wait: waitpid, return '' or pid code/-signo
        options:
                -zombies: collect all pending childs (before command)
                -pid n: use n for waitpid
                -maxchilds n: max n childs: if nchilds >= n, wait (with -block) or error
                -hang: block (default is WNOHANG)
*/
static int forkCmd (
        ClientData ignore, Tcl_Interp *ip, int objc, Tcl_Obj* const objv[]
) {
        static const char *cmds[] = {"child", "numchilds", "wait", 0};
        enum { CMD_FRK, CMD_NUM, CMD_WAIT };
        int cmd = CMD_FRK;
        static const char *opts[] = {"-zombies", "-pid", "-maxchilds", "-hang", 0};
        enum { OPT_ZOM, OPT_PID, OPT_MAX, OPT_BLK };
        static int num = 0;
        int zom=0, pid=-1, max=0, flg=WNOHANG, status;
        Tcl_Obj *const*obj=objv+1, *const*eob=objv+objc;

        (void)ignore;
        if ( obj < eob ) {
                if ( TCL_OK == Tcl_GetIndexFromObj(ip, *obj, cmds, "command", 0, &cmd) )
                        obj++;
                for (;obj < eob; obj++) {
                        int opt, val;
                        if ( TCL_OK != Tcl_GetIndexFromObj(ip, *obj, opts, "option", 0, &opt) )
                                return TCL_ERROR;
                        switch (opt) {
                        case OPT_ZOM: zom=1; continue;
                        case OPT_BLK: flg=0; continue;
                        }
                        if ( eob > ++obj ) {
                                if ( TCL_OK == Tcl_GetIntFromObj(ip, *obj, &val) )
                                        switch (opt) {
                                        case OPT_PID: pid=val; continue;
                                        case OPT_MAX: max=val; continue;
                                        }
                        } else
                                Tcl_SetResult(ip, "option needs value", TCL_STATIC);
                        return TCL_ERROR;
                }
        }
        if ( zom && num )
                while (0 < waitpid(pid, 0, WNOHANG)) /* ignore errors */
                        num--;
        switch (cmd) {
        case CMD_FRK:
                if ( max && max <= num ) {
                        if ( !flg )
                                while (0 < waitpid(pid,0,0) && max <= --num )
                                        ;
                        if ( max <= num ) { /* wouldn't or couldn't wait */
                                Tcl_SetResult(ip, "too many childs", TCL_STATIC);
                                return TCL_ERROR;
                        }
                }
                Tcl_SetIntObj(Tcl_GetObjResult(ip), pid = fork());
                if (!pid)
                        num = 0;
                else if (0 < pid)
                        num++;
                else
                        goto syserr;
                return TCL_OK;
        case CMD_NUM:
                Tcl_SetIntObj(Tcl_GetObjResult(ip), num);
                return TCL_OK;
        case CMD_WAIT:
                if ( 0 > (pid = waitpid(pid, &status, flg)) )
                        goto syserr;
                if ( pid ) {
                        char buf[64];
                        int code;
                        if ( WIFEXITED(status) )
                                code = WEXITSTATUS(status);
                        else if ( WIFSIGNALED(status) )
                                code = -WTERMSIG(status);
                        else
                                code = 999; /* not a valid exit status */
                        /* else strange, since we don't use WUNTRACED */
                        sprintf(buf, "%d %d", pid, code);
                        Tcl_SetResult(ip, buf, TCL_VOLATILE);
                }
                return TCL_OK;
        }
syserr:
        Tcl_SetResult(ip, (char*)Tcl_ErrnoMsg(Tcl_GetErrno()), TCL_VOLATILE);
        return TCL_ERROR;
}       /* forkCmd */


/*
        ugly, but needed sometimes
*/
static int cryptCmd (
        ClientData ignore, Tcl_Interp *ip, int objc, Tcl_Obj* const objv[]
) {
        typedef char *cryptfnc(const char *key, const char *salt);
        static void *libcrypt;
        static cryptfnc *dyncrypt;

        (void)ignore;
        if ( 3 != objc ) {
                Tcl_SetResult(ip, "crypt key salt", TCL_STATIC);
                return TCL_ERROR;
        }
        if ( !libcrypt ) {
                if ( dyncrypt /* previous attempt */
                        || !(libcrypt = dlopen("libcrypt.so.1",RTLD_NOW|RTLD_GLOBAL))
                        || !(dyncrypt = (cryptfnc*)dlsym(libcrypt, "crypt"))
                ) {
                        if ( libcrypt ) {
                                dlclose(libcrypt);
                                libcrypt = 0;
                        }
                        dyncrypt = (cryptfnc*)-1;
                        Tcl_SetResult(ip, "no libcrypt", TCL_STATIC);
                        Tcl_DeleteCommand(ip, Tcl_GetString(objv[0])); /* suicide */
                        return TCL_ERROR;
                }
        }
        Tcl_SetResult(ip, dyncrypt(Tcl_GetString(objv[1]), Tcl_GetString(objv[2])),
                TCL_VOLATILE);
        return TCL_OK;
}       /* cryptCmd */


/* cdb -- see http://cr.yp.to/cdb/cdb.txt */
/* does not really require *nix, but who cares ... */
#ifdef CPU_BIG_ENDIAN /* bigendians need swapping of all numbas */
/* base table IS aligned, tables MAYBE, records ARE NOT aligned by spec */
/* at least sparcy needs alignment */
static unsigned READLE (char *p)
{
        union {
                unsigned i;
                char c[4];
        } u;
        u.c[0] = p[3]; u.c[1] = p[2]; u.c[2] = p[1]; u.c[3] = p[0];
        return u.i;
}
#else /* all little endians get by w/o alignment ? */
#       define READLE(x) (*(unsigned*)(x))
#endif

typedef struct {
        char    *db; /* mmap */
        unsigned len;
        Tcl_Obj *def; /* default */
} Cdb;

/*
        commandname key
        return value for key from this cdb, default or error if not found
*/
static int cdbObjCmd (
        ClientData cd, Tcl_Interp *ip, int objc, Tcl_Obj* const objv[]
) {
        if (2 == objc) {
                Cdb *c = (Cdb *)cd;
                unsigned len = 0, max = c->len;
                unsigned char *key;
                char *tb, *te, *ts, *tp;
                unsigned h = 5381;
                
                /* compute hash */ {
                        unsigned char *p = (key = &tclByteArrayType == objv[1]->typePtr
                                ? Tcl_GetByteArrayFromObj(objv[1], (int*)&len)
                                : (unsigned char*)Tcl_GetStringFromObj(objv[1], (int*)&len)),
                                *e = p + len;
                        if ( len > c->len - 2048 )
                                goto notfound;
                        while (p < e)
                                h = ((h << 5) + h) ^ *p++;
                }
                /* offset, #slots of table */ { /* we checked c->len >= 2K */
                        char *t = c->db + ((h & 0xff)<<3); /* 2*4 byte units */
                        unsigned tpos = READLE(t);
                        unsigned tlen = READLE(t+4);
                        unsigned tend = tpos + (tlen<<3);
                        if ( tpos > max || tlen > max || tend > max
                                || tend < tpos || tlen != (tend-tpos)>>3
                        )       /* paranoia */
                                goto corrupt;
                        tb = c->db + tpos; /* table base */
                        te = tb + (tlen<<3); /* table end */
                        tp = ts = tb + ((h>>8)%tlen<<3); /* table pointer, start slot */
                }
                max -= len+8; /* record pos */
                do { /* hash and a pos as tp */
                        unsigned rpos = READLE(tp+4);
                        if ( !rpos ) break; /* no pos - empty slot */
                        if ( h == READLE(tp) ) { /* possible match */
                                char *rec;
                                if ( rpos > max )
                                        goto corrupt;
                                if ( len == READLE(rec = c->db+rpos) && !memcmp(key, rec+8, len) ) {
                                        unsigned rlen = READLE(rec+4);
                                        if (rlen <= max-rpos ) {
                                                Tcl_SetStringObj(Tcl_GetObjResult(ip), rec+8+len, rlen);
                                                return TCL_OK;
                                        }
                                        goto corrupt;
                                }
                        }
                        if ( te == (tp+=8) ) tp = tb;
                } while (ts != tp);
        notfound:
                if ( c->def )
                        Tcl_SetObjResult(ip, c->def);
                return TCL_OK;
        corrupt:
                Tcl_SetResult(ip, "cdb is corrupt", TCL_STATIC);
                return TCL_ERROR;
        }
        Tcl_AppendResult(ip, "usage: ", Tcl_GetString(objv[0]), " key", 0);
        return TCL_ERROR;
}       /* cdbObjCmd */


static void cdbObjDel (ClientData cd)
{
        Cdb *c = (Cdb *)cd;
        if ( c->db )
                munmap(c->db, c->len);
        if ( c->def )
                Tcl_DecrRefCount(c->def);
        Tcl_Free(cd);
}       /* cdbObjDel */


/*
        cdb commandname filename
        create commandname as cdb command
*/
static int cdbCmd (
        ClientData ignore, Tcl_Interp *ip, int objc, Tcl_Obj* const objv[]
) {
        Cdb *c;
        int fd;
        struct stat st;

        switch (objc) {
        case 3:
        case 4:
                fd = open(Tcl_GetString(objv[2]), O_RDONLY, 0);
                if ( -1 == fd ) {
                        Tcl_SetResult(ip, "bad filename", TCL_STATIC);
                        return TCL_ERROR;
                }
                c = (Cdb*)Tcl_Alloc(sizeof(*c));
                c->db = fstat(fd, &st) || 2048 > st.st_size ? MAP_FAILED :
                        mmap(0, c->len = st.st_size, PROT_READ, MAP_SHARED, fd, 0);
                close(fd);
                if ( MAP_FAILED == c->db ) {
                        Tcl_SetResult(ip, "could not mmap", TCL_STATIC);
                        Tcl_Free((char*)c);
                        return TCL_ERROR;
                }
                if ( 3 == objc )
                        c->def = 0;
                else {
                        c->def = Tcl_DuplicateObj(objv[3]);
                        Tcl_IncrRefCount(c->def); /* it's a macro :( */
                }
                Tcl_CreateObjCommand(ip, Tcl_GetString(objv[1]), cdbObjCmd,
                        (ClientData)c, cdbObjDel);
                return TCL_OK;
        }
        (void)ignore;
        Tcl_AppendResult(ip, "usage: ", Tcl_GetString(objv[0]),
                " commandname filename ?default?", 0);
        return TCL_ERROR;
}       /* cdbCmd */


int unixInit (Tcl_Interp *ip)
{
        Tcl_CreateObjCommand(ip, "::malete::lockf", lockfCmd, 0, 0);
        Tcl_CreateObjCommand(ip, "::malete::sendfile", sendfileCmd, 0, 0);
        Tcl_CreateObjCommand(ip, "::malete::fork", forkCmd, 0, 0);
        Tcl_CreateObjCommand(ip, "::malete::crypt", cryptCmd, 0, 0);
        Tcl_CreateObjCommand(ip, "::malete::cdb", cdbCmd, 0, 0);
        return TCL_OK;
}
1	dpavlin	604	/*
2			The Malete project - the Z39.2/Z39.50 database framework of OpenIsis.
3			Version 0.9.x (patchlevel see file Version)
4			Copyright (C) 2001-2004 by Erik Grziwotz, erik@openisis.org
5
6			This library is free software; you can redistribute it and/or
7			modify it under the terms of the GNU Lesser General Public
8			License as published by the Free Software Foundation; either
9			version 2.1 of the License, or (at your option) any later version.
10
11			This library is distributed in the hope that it will be useful,
12			but WITHOUT ANY WARRANTY; without even the implied warranty of
13			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14			See the GNU Lesser General Public License for more details.
15
16			You should have received a copy of the GNU Lesser General Public
17			License along with this library; if not, write to the Free Software
18			Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19
20			see README for more information
21			EOH */
22
23			/*
24			$Id: unix.c,v 1.7 2004/09/29 16:35:11 kripke Exp $
25			malete unix utilities for Tcl
26			*/
27
28			/* #include <tclInt.h> */
29			#include <tcl.h>
30			/* #include <tclInt.h> tclByteArrayType */
31			extern Tcl_ObjType tclByteArrayType;
32
33			#include <sys/types.h>
34			#include <sys/mman.h>
35			#include <sys/stat.h>
36			#include <sys/wait.h>
37			#include <sys/sendfile.h>
38			#include <unistd.h>
39			#include <fcntl.h>
40			#include <string.h> /* memcmp :( */
41			#include <dlfcn.h> /* avoid -lcrypt; -ldl we have anyway */
42
43			#if defined( __sparc__ ) \|\| defined( __ppc__ )
44			# define CPU_BIG_ENDIAN
45			#endif
46
47			/*
48			lockf channel ?mode ?nowait??
49			lock complete file like flock, but based on fcntl/lockf
50			mode is: unlock, shared or exclusive (or unique abbr.)
51			defaults to exclusive, if channel is writable, shared else
52			*/
53			static int lockfCmd (
54			ClientData ignore, Tcl_Interp ip, int objc, Tcl_Obj const objv[]
55			) {
56			static const char *modenames[] = {"unlock", "shared", "exclusive", 0};
57			static const short l_type[] = {F_UNLCK, F_RDLCK, F_WRLCK};
58			ClientData fd;
59			int mode, isopen;
60			struct flock fl;
61			char *name;
62			Tcl_Channel chan;
63
64			(void)ignore;
65			switch (objc) {
66			case 2:
67			case 3:
68			case 4:
69			chan = Tcl_GetChannel(ip, name = Tcl_GetString(objv[1]), &isopen);
70			if ( !chan
71			\|\| (TCL_OK != Tcl_GetChannelHandle(chan, TCL_READABLE, &fd))
72			) {
73			Tcl_AppendResult (ip, "bad channel: ", name, 0);
74			return TCL_ERROR;
75			}
76			if ( 2 == objc )
77			mode = (TCL_WRITABLE & isopen) ? 2 : 1;
78			else if ( TCL_OK !=
79			Tcl_GetIndexFromObj(ip, objv[2], modenames, "locking mode", 0, &mode)
80			)
81			return TCL_ERROR;
82			fl.l_type = l_type[mode];
83			fl.l_whence = SEEK_SET;
84			fl.l_start = 0;
85			fl.l_len = 0;
86			Tcl_SetIntObj(Tcl_GetObjResult(ip),
87			-1 != fcntl((int)fd, (4==objc) ? F_SETLK : F_SETLKW, &fl));
88			return TCL_OK;
89			}
90			Tcl_AppendResult(ip, "usage: ", Tcl_GetString(objv[0]),
91			" channel ?mode ?nowait??", 0);
92			return TCL_ERROR;
93			} /* lockfCmd */
94
95
96
97			/*
98			sendfile tochannel fromchannel ?offset ?len??
99			*/
100			static int sendfileCmd (
101			ClientData ignore, Tcl_Interp ip, int objc, Tcl_Obj const objv[]
102			) {
103			ClientData infd, outfd;
104			int isopen, off = 0, len = 0;
105			Tcl_Channel chan;
106
107			(void)ignore;
108			switch (objc) {
109			case 5:
110			if ( TCL_OK != Tcl_GetIntFromObj(ip, objv[4], &len) ) return TCL_ERROR;
111			case 4:
112			if ( TCL_OK != Tcl_GetIntFromObj(ip, objv[3], &off) ) return TCL_ERROR;
113			case 3:
114			if ( !(chan = Tcl_GetChannel(ip, Tcl_GetString(objv[2]), &isopen))
115			\|\| !(TCL_READABLE & isopen)
116			\|\| (TCL_OK != Tcl_GetChannelHandle(chan, TCL_READABLE, &infd))
117			) {
118			Tcl_SetResult (ip, "not readable", TCL_STATIC);
119			return TCL_ERROR;
120			}
121			if ( !(chan = Tcl_GetChannel(ip, Tcl_GetString(objv[1]), &isopen))
122			\|\| !(TCL_WRITABLE & isopen)
123			\|\| (TCL_OK != Tcl_GetChannelHandle(chan, TCL_WRITABLE, &outfd))
124			) {
125			Tcl_SetResult (ip, "not writable", TCL_STATIC);
126			return TCL_ERROR;
127			}
128			if ( !len ) {
129			struct stat st;
130			if ( fstat((int)infd, &st) ) {
131			Tcl_SetResult (ip, "not statable", TCL_STATIC);
132			return TCL_ERROR;
133			}
134			if ( off >= st.st_size )
135			return TCL_OK;
136			len = st.st_size - off;
137			}
138			Tcl_SetIntObj(Tcl_GetObjResult(ip),
139			(int)sendfile((int)outfd, (int)infd, (off_t*)&off, (size_t)len));
140			return TCL_OK;
141			}
142			Tcl_AppendResult(ip, "usage: ", Tcl_GetString(objv[0]),
143			" tochannel fromchannel ?offset ?len??", 0);
144			return TCL_ERROR;
145			} /* sendfileCmd */
146
147
148			/*
149			fork [command] [options ...]
150			command:
151			child (default): fork
152			numchilds: return number of childs
153			wait: waitpid, return '' or pid code/-signo
154			options:
155			-zombies: collect all pending childs (before command)
156			-pid n: use n for waitpid
157			-maxchilds n: max n childs: if nchilds >= n, wait (with -block) or error
158			-hang: block (default is WNOHANG)
159			*/
160			static int forkCmd (
161			ClientData ignore, Tcl_Interp ip, int objc, Tcl_Obj const objv[]
162			) {
163			static const char *cmds[] = {"child", "numchilds", "wait", 0};
164			enum { CMD_FRK, CMD_NUM, CMD_WAIT };
165			int cmd = CMD_FRK;
166			static const char *opts[] = {"-zombies", "-pid", "-maxchilds", "-hang", 0};
167			enum { OPT_ZOM, OPT_PID, OPT_MAX, OPT_BLK };
168			static int num = 0;
169			int zom=0, pid=-1, max=0, flg=WNOHANG, status;
170			Tcl_Obj constobj=objv+1, consteob=objv+objc;
171
172			(void)ignore;
173			if ( obj < eob ) {
174			if ( TCL_OK == Tcl_GetIndexFromObj(ip, *obj, cmds, "command", 0, &cmd) )
175			obj++;
176			for (;obj < eob; obj++) {
177			int opt, val;
178			if ( TCL_OK != Tcl_GetIndexFromObj(ip, *obj, opts, "option", 0, &opt) )
179			return TCL_ERROR;
180			switch (opt) {
181			case OPT_ZOM: zom=1; continue;
182			case OPT_BLK: flg=0; continue;
183			}
184			if ( eob > ++obj ) {
185			if ( TCL_OK == Tcl_GetIntFromObj(ip, *obj, &val) )
186			switch (opt) {
187			case OPT_PID: pid=val; continue;
188			case OPT_MAX: max=val; continue;
189			}
190			} else
191			Tcl_SetResult(ip, "option needs value", TCL_STATIC);
192			return TCL_ERROR;
193			}
194			}
195			if ( zom && num )
196			while (0 < waitpid(pid, 0, WNOHANG)) /* ignore errors */
197			num--;
198			switch (cmd) {
199			case CMD_FRK:
200			if ( max && max <= num ) {
201			if ( !flg )
202			while (0 < waitpid(pid,0,0) && max <= --num )
203			;
204			if ( max <= num ) { /* wouldn't or couldn't wait */
205			Tcl_SetResult(ip, "too many childs", TCL_STATIC);
206			return TCL_ERROR;
207			}
208			}
209			Tcl_SetIntObj(Tcl_GetObjResult(ip), pid = fork());
210			if (!pid)
211			num = 0;
212			else if (0 < pid)
213			num++;
214			else
215			goto syserr;
216			return TCL_OK;
217			case CMD_NUM:
218			Tcl_SetIntObj(Tcl_GetObjResult(ip), num);
219			return TCL_OK;
220			case CMD_WAIT:
221			if ( 0 > (pid = waitpid(pid, &status, flg)) )
222			goto syserr;
223			if ( pid ) {
224			char buf[64];
225			int code;
226			if ( WIFEXITED(status) )
227			code = WEXITSTATUS(status);
228			else if ( WIFSIGNALED(status) )
229			code = -WTERMSIG(status);
230			else
231			code = 999; /* not a valid exit status */
232			/* else strange, since we don't use WUNTRACED */
233			sprintf(buf, "%d %d", pid, code);
234			Tcl_SetResult(ip, buf, TCL_VOLATILE);
235			}
236			return TCL_OK;
237			}
238			syserr:
239			Tcl_SetResult(ip, (char*)Tcl_ErrnoMsg(Tcl_GetErrno()), TCL_VOLATILE);
240			return TCL_ERROR;
241			} /* forkCmd */
242
243
244			/*
245			ugly, but needed sometimes
246			*/
247			static int cryptCmd (
248			ClientData ignore, Tcl_Interp ip, int objc, Tcl_Obj const objv[]
249			) {
250			typedef char cryptfnc(const char key, const char *salt);
251			static void *libcrypt;
252			static cryptfnc *dyncrypt;
253
254			(void)ignore;
255			if ( 3 != objc ) {
256			Tcl_SetResult(ip, "crypt key salt", TCL_STATIC);
257			return TCL_ERROR;
258			}
259			if ( !libcrypt ) {
260			if ( dyncrypt /* previous attempt */
261			\|\| !(libcrypt = dlopen("libcrypt.so.1",RTLD_NOW\|RTLD_GLOBAL))
262			\|\| !(dyncrypt = (cryptfnc*)dlsym(libcrypt, "crypt"))
263			) {
264			if ( libcrypt ) {
265			dlclose(libcrypt);
266			libcrypt = 0;
267			}
268			dyncrypt = (cryptfnc*)-1;
269			Tcl_SetResult(ip, "no libcrypt", TCL_STATIC);
270			Tcl_DeleteCommand(ip, Tcl_GetString(objv[0])); /* suicide */
271			return TCL_ERROR;
272			}
273			}
274			Tcl_SetResult(ip, dyncrypt(Tcl_GetString(objv[1]), Tcl_GetString(objv[2])),
275			TCL_VOLATILE);
276			return TCL_OK;
277			} /* cryptCmd */
278
279
280			/* cdb -- see http://cr.yp.to/cdb/cdb.txt */
281			/* does not really require nix, but who cares ... /
282			#ifdef CPU_BIG_ENDIAN /* bigendians need swapping of all numbas */
283			/* base table IS aligned, tables MAYBE, records ARE NOT aligned by spec */
284			/* at least sparcy needs alignment */
285			static unsigned READLE (char *p)
286			{
287			union {
288			unsigned i;
289			char c[4];
290			} u;
291			u.c[0] = p[3]; u.c[1] = p[2]; u.c[2] = p[1]; u.c[3] = p[0];
292			return u.i;
293			}
294			#else /* all little endians get by w/o alignment ? */
295			# define READLE(x) ((unsigned)(x))
296			#endif
297
298			typedef struct {
299			char db; / mmap */
300			unsigned len;
301			Tcl_Obj def; / default */
302			} Cdb;
303
304			/*
305			commandname key
306			return value for key from this cdb, default or error if not found
307			*/
308			static int cdbObjCmd (
309			ClientData cd, Tcl_Interp ip, int objc, Tcl_Obj const objv[]
310			) {
311			if (2 == objc) {
312			Cdb c = (Cdb )cd;
313			unsigned len = 0, max = c->len;
314			unsigned char *key;
315			char tb, te, ts, tp;
316			unsigned h = 5381;
317
318			/* compute hash */ {
319			unsigned char *p = (key = &tclByteArrayType == objv[1]->typePtr
320			? Tcl_GetByteArrayFromObj(objv[1], (int*)&len)
321			: (unsigned char)Tcl_GetStringFromObj(objv[1], (int)&len)),
322			*e = p + len;
323			if ( len > c->len - 2048 )
324			goto notfound;
325			while (p < e)
326			h = ((h << 5) + h) ^ *p++;
327			}
328			/* offset, #slots of table / { / we checked c->len >= 2K */
329			char t = c->db + ((h & 0xff)<<3); / 24 byte units /
330			unsigned tpos = READLE(t);
331			unsigned tlen = READLE(t+4);
332			unsigned tend = tpos + (tlen<<3);
333			if ( tpos > max \|\| tlen > max \|\| tend > max
334			\|\| tend < tpos \|\| tlen != (tend-tpos)>>3
335			) /* paranoia */
336			goto corrupt;
337			tb = c->db + tpos; /* table base */
338			te = tb + (tlen<<3); /* table end */
339			tp = ts = tb + ((h>>8)%tlen<<3); /* table pointer, start slot */
340			}
341			max -= len+8; /* record pos */
342			do { /* hash and a pos as tp */
343			unsigned rpos = READLE(tp+4);
344			if ( !rpos ) break; /* no pos - empty slot */
345			if ( h == READLE(tp) ) { /* possible match */
346			char *rec;
347			if ( rpos > max )
348			goto corrupt;
349			if ( len == READLE(rec = c->db+rpos) && !memcmp(key, rec+8, len) ) {
350			unsigned rlen = READLE(rec+4);
351			if (rlen <= max-rpos ) {
352			Tcl_SetStringObj(Tcl_GetObjResult(ip), rec+8+len, rlen);
353			return TCL_OK;
354			}
355			goto corrupt;
356			}
357			}
358			if ( te == (tp+=8) ) tp = tb;
359			} while (ts != tp);
360			notfound:
361			if ( c->def )
362			Tcl_SetObjResult(ip, c->def);
363			return TCL_OK;
364			corrupt:
365			Tcl_SetResult(ip, "cdb is corrupt", TCL_STATIC);
366			return TCL_ERROR;
367			}
368			Tcl_AppendResult(ip, "usage: ", Tcl_GetString(objv[0]), " key", 0);
369			return TCL_ERROR;
370			} /* cdbObjCmd */
371
372
373			static void cdbObjDel (ClientData cd)
374			{
375			Cdb c = (Cdb )cd;
376			if ( c->db )
377			munmap(c->db, c->len);
378			if ( c->def )
379			Tcl_DecrRefCount(c->def);
380			Tcl_Free(cd);
381			} /* cdbObjDel */
382
383
384			/*
385			cdb commandname filename
386			create commandname as cdb command
387			*/
388			static int cdbCmd (
389			ClientData ignore, Tcl_Interp ip, int objc, Tcl_Obj const objv[]
390			) {
391			Cdb *c;
392			int fd;
393			struct stat st;
394
395			switch (objc) {
396			case 3:
397			case 4:
398			fd = open(Tcl_GetString(objv[2]), O_RDONLY, 0);
399			if ( -1 == fd ) {
400			Tcl_SetResult(ip, "bad filename", TCL_STATIC);
401			return TCL_ERROR;
402			}
403			c = (Cdb)Tcl_Alloc(sizeof(c));
404			c->db = fstat(fd, &st) \|\| 2048 > st.st_size ? MAP_FAILED :
405			mmap(0, c->len = st.st_size, PROT_READ, MAP_SHARED, fd, 0);
406			close(fd);
407			if ( MAP_FAILED == c->db ) {
408			Tcl_SetResult(ip, "could not mmap", TCL_STATIC);
409			Tcl_Free((char*)c);
410			return TCL_ERROR;
411			}
412			if ( 3 == objc )
413			c->def = 0;
414			else {
415			c->def = Tcl_DuplicateObj(objv[3]);
416			Tcl_IncrRefCount(c->def); /* it's a macro :( */
417			}
418			Tcl_CreateObjCommand(ip, Tcl_GetString(objv[1]), cdbObjCmd,
419			(ClientData)c, cdbObjDel);
420			return TCL_OK;
421			}
422			(void)ignore;
423			Tcl_AppendResult(ip, "usage: ", Tcl_GetString(objv[0]),
424			" commandname filename ?default?", 0);
425			return TCL_ERROR;
426			} /* cdbCmd */
427
428
429			int unixInit (Tcl_Interp *ip)
430			{
431			Tcl_CreateObjCommand(ip, "::malete::lockf", lockfCmd, 0, 0);
432			Tcl_CreateObjCommand(ip, "::malete::sendfile", sendfileCmd, 0, 0);
433			Tcl_CreateObjCommand(ip, "::malete::fork", forkCmd, 0, 0);
434			Tcl_CreateObjCommand(ip, "::malete::crypt", cryptCmd, 0, 0);
435			Tcl_CreateObjCommand(ip, "::malete::cdb", cdbCmd, 0, 0);
436			return TCL_OK;
437			}