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 |
} |