/[webpac]/openisis/0.9.9e/tcl/unix.c
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /openisis/0.9.9e/tcl/unix.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 604 - (show annotations)
Mon Dec 27 21:49:01 2004 UTC (18 years, 1 month ago) by dpavlin
File MIME type: text/plain
File size: 11981 byte(s)
import of new openisis release, 0.9.9e

1 /*
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 *const*obj=objv+1, *const*eob=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); /* 2*4 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 }

  ViewVC Help
Powered by ViewVC 1.1.26