Commit | Line | Data |
8f85282b |
1 | /******************************************************************************* |
2 | * |
a7c93bfc |
3 | * $Revision: 31 $ |
8f85282b |
4 | * $Author: mhx $ |
a7c93bfc |
5 | * $Date: 2007/12/29 19:46:18 +0100 $ |
8f85282b |
6 | * |
7 | ******************************************************************************** |
8 | * |
9 | * Version 2.x, Copyright (C) 2007, Marcus Holland-Moritz <mhx@cpan.org>. |
10 | * Version 1.x, Copyright (C) 1999, Graham Barr <gbarr@pobox.com>. |
11 | * |
12 | * This program is free software; you can redistribute it and/or |
13 | * modify it under the same terms as Perl itself. |
14 | * |
15 | *******************************************************************************/ |
16 | |
0ade1984 |
17 | #include "EXTERN.h" |
18 | #include "perl.h" |
19 | #include "XSUB.h" |
20 | |
8f85282b |
21 | #define NEED_sv_2pv_flags |
22 | #define NEED_sv_pvn_force_flags |
23 | #include "ppport.h" |
24 | |
0ade1984 |
25 | #include <sys/types.h> |
8f85282b |
26 | |
0ade1984 |
27 | #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) |
8f85282b |
28 | # ifndef HAS_SEM |
29 | # include <sys/ipc.h> |
30 | # endif |
31 | # ifdef HAS_MSG |
32 | # include <sys/msg.h> |
33 | # endif |
34 | # ifdef HAS_SHM |
35 | # if defined(PERL_SCO) || defined(PERL_ISC) |
36 | # include <sys/sysmacros.h> /* SHMLBA */ |
37 | # endif |
38 | # include <sys/shm.h> |
39 | # ifndef HAS_SHMAT_PROTOTYPE |
40 | extern Shmat_t shmat(int, char *, int); |
41 | # endif |
42 | # if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE) |
43 | # undef SHMLBA /* not static: determined at boot time */ |
44 | # define SHMLBA sysconf(_SC_PAGESIZE) |
45 | # elif defined(HAS_GETPAGESIZE) |
46 | # undef SHMLBA /* not static: determined at boot time */ |
47 | # define SHMLBA getpagesize() |
48 | # endif |
49 | # endif |
0ade1984 |
50 | #endif |
51 | |
aec308ec |
52 | /* Required to get 'struct pte' for SHMLBA on ULTRIX. */ |
53 | #if defined(__ultrix) || defined(__ultrix__) || defined(ultrix) |
54 | #include <machine/pte.h> |
55 | #endif |
56 | |
1e509ade |
57 | /* Required in BSDI to get PAGE_SIZE definition for SHMLBA. |
58 | * Ugly. More beautiful solutions welcome. |
59 | * Shouting at BSDI sounds quite beautiful. */ |
60 | #ifdef __bsdi__ |
8f85282b |
61 | # include <vm/vm_param.h> /* move upwards under HAS_SHM? */ |
1e509ade |
62 | #endif |
63 | |
85ab1d1d |
64 | #ifndef S_IRWXU |
8f85282b |
65 | # ifdef S_IRUSR |
66 | # define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) |
67 | # define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) |
68 | # define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) |
69 | # else |
70 | # define S_IRWXU 0700 |
71 | # define S_IRWXG 0070 |
72 | # define S_IRWXO 0007 |
73 | # endif |
85ab1d1d |
74 | #endif |
75 | |
8f85282b |
76 | #define AV_FETCH_IV(ident, av, index) \ |
77 | STMT_START { \ |
78 | SV **svp; \ |
79 | if ((svp = av_fetch((av), (index), FALSE)) != NULL) \ |
80 | ident = SvIV(*svp); \ |
81 | } STMT_END |
82 | |
83 | #define AV_STORE_IV(ident, av, index) \ |
84 | av_store((av), (index), newSViv(ident)) |
85 | |
86 | static const char *s_fmt_not_isa = "Method %s not called a %s object"; |
87 | static const char *s_bad_length = "Bad arg length for %s, length is %d, should be %d"; |
88 | static const char *s_sysv_unimpl PERL_UNUSED_DECL |
89 | = "System V %sxxx is not implemented on this machine"; |
90 | |
91 | static const char *s_pkg_msg = "IPC::Msg::stat"; |
92 | static const char *s_pkg_sem = "IPC::Semaphore::stat"; |
93 | static const char *s_pkg_shm = "IPC::SharedMem::stat"; |
94 | |
95 | static void *sv2addr(SV *sv) |
96 | { |
97 | if (SvPOK(sv) && SvCUR(sv) == sizeof(void *)) |
98 | { |
99 | return *((void **) SvPVX(sv)); |
100 | } |
101 | |
102 | croak("invalid address value"); |
103 | |
104 | return 0; |
105 | } |
106 | |
107 | static void assert_sv_isa(SV *sv, const char *name, const char *method) |
108 | { |
109 | if (!sv_isa(sv, name)) |
110 | { |
111 | croak(s_fmt_not_isa, method, name); |
112 | } |
113 | } |
114 | |
115 | static void assert_data_length(const char *name, int got, int expected) |
116 | { |
117 | if (got != expected) |
118 | { |
119 | croak(s_bad_length, name, got, expected); |
120 | } |
121 | } |
122 | |
123 | #include "const-c.inc" |
124 | |
125 | |
0ade1984 |
126 | MODULE=IPC::SysV PACKAGE=IPC::Msg::stat |
127 | |
128 | PROTOTYPES: ENABLE |
129 | |
130 | void |
131 | pack(obj) |
132 | SV * obj |
133 | PPCODE: |
8f85282b |
134 | { |
6087ac44 |
135 | #ifdef HAS_MSG |
8f85282b |
136 | AV *list = (AV*) SvRV(obj); |
0ade1984 |
137 | struct msqid_ds ds; |
8f85282b |
138 | assert_sv_isa(obj, s_pkg_msg, "pack"); |
139 | AV_FETCH_IV(ds.msg_perm.uid , list, 0); |
140 | AV_FETCH_IV(ds.msg_perm.gid , list, 1); |
141 | AV_FETCH_IV(ds.msg_perm.cuid, list, 2); |
142 | AV_FETCH_IV(ds.msg_perm.cgid, list, 3); |
143 | AV_FETCH_IV(ds.msg_perm.mode, list, 4); |
144 | AV_FETCH_IV(ds.msg_qnum , list, 5); |
145 | AV_FETCH_IV(ds.msg_qbytes , list, 6); |
146 | AV_FETCH_IV(ds.msg_lspid , list, 7); |
147 | AV_FETCH_IV(ds.msg_lrpid , list, 8); |
148 | AV_FETCH_IV(ds.msg_stime , list, 9); |
149 | AV_FETCH_IV(ds.msg_rtime , list, 10); |
150 | AV_FETCH_IV(ds.msg_ctime , list, 11); |
151 | ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds))); |
0ade1984 |
152 | XSRETURN(1); |
6087ac44 |
153 | #else |
8f85282b |
154 | croak(s_sysv_unimpl, "msg"); |
6087ac44 |
155 | #endif |
8f85282b |
156 | } |
0ade1984 |
157 | |
158 | void |
8f85282b |
159 | unpack(obj, ds) |
0ade1984 |
160 | SV * obj |
8f85282b |
161 | SV * ds |
0ade1984 |
162 | PPCODE: |
8f85282b |
163 | { |
6087ac44 |
164 | #ifdef HAS_MSG |
8f85282b |
165 | AV *list = (AV*) SvRV(obj); |
0ade1984 |
166 | STRLEN len; |
8f85282b |
167 | const struct msqid_ds *data = (struct msqid_ds *) SvPV_const(ds, len); |
168 | assert_sv_isa(obj, s_pkg_msg, "unpack"); |
169 | assert_data_length(s_pkg_msg, len, sizeof(*data)); |
170 | AV_STORE_IV(data->msg_perm.uid , list, 0); |
171 | AV_STORE_IV(data->msg_perm.gid , list, 1); |
172 | AV_STORE_IV(data->msg_perm.cuid, list, 2); |
173 | AV_STORE_IV(data->msg_perm.cgid, list, 3); |
174 | AV_STORE_IV(data->msg_perm.mode, list, 4); |
175 | AV_STORE_IV(data->msg_qnum , list, 5); |
176 | AV_STORE_IV(data->msg_qbytes , list, 6); |
177 | AV_STORE_IV(data->msg_lspid , list, 7); |
178 | AV_STORE_IV(data->msg_lrpid , list, 8); |
179 | AV_STORE_IV(data->msg_stime , list, 9); |
180 | AV_STORE_IV(data->msg_rtime , list, 10); |
181 | AV_STORE_IV(data->msg_ctime , list, 11); |
0ade1984 |
182 | XSRETURN(1); |
6087ac44 |
183 | #else |
8f85282b |
184 | croak(s_sysv_unimpl, "msg"); |
6087ac44 |
185 | #endif |
8f85282b |
186 | } |
187 | |
0ade1984 |
188 | |
189 | MODULE=IPC::SysV PACKAGE=IPC::Semaphore::stat |
190 | |
8f85282b |
191 | PROTOTYPES: ENABLE |
192 | |
0ade1984 |
193 | void |
8f85282b |
194 | pack(obj) |
195 | SV * obj |
196 | PPCODE: |
197 | { |
198 | #ifdef HAS_SEM |
199 | AV *list = (AV*) SvRV(obj); |
200 | struct semid_ds ds; |
201 | assert_sv_isa(obj, s_pkg_sem, "pack"); |
202 | AV_FETCH_IV(ds.sem_perm.uid , list, 0); |
203 | AV_FETCH_IV(ds.sem_perm.gid , list, 1); |
204 | AV_FETCH_IV(ds.sem_perm.cuid, list, 2); |
205 | AV_FETCH_IV(ds.sem_perm.cgid, list, 3); |
206 | AV_FETCH_IV(ds.sem_perm.mode, list, 4); |
207 | AV_FETCH_IV(ds.sem_ctime , list, 5); |
208 | AV_FETCH_IV(ds.sem_otime , list, 6); |
209 | AV_FETCH_IV(ds.sem_nsems , list, 7); |
210 | ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds))); |
211 | XSRETURN(1); |
212 | #else |
213 | croak(s_sysv_unimpl, "sem"); |
214 | #endif |
215 | } |
216 | |
217 | void |
218 | unpack(obj, ds) |
0ade1984 |
219 | SV * obj |
220 | SV * ds |
221 | PPCODE: |
8f85282b |
222 | { |
6087ac44 |
223 | #ifdef HAS_SEM |
8f85282b |
224 | AV *list = (AV*) SvRV(obj); |
0ade1984 |
225 | STRLEN len; |
8f85282b |
226 | const struct semid_ds *data = (struct semid_ds *) SvPV_const(ds, len); |
227 | assert_sv_isa(obj, s_pkg_sem, "unpack"); |
228 | assert_data_length(s_pkg_sem, len, sizeof(*data)); |
229 | AV_STORE_IV(data->sem_perm.uid , list, 0); |
230 | AV_STORE_IV(data->sem_perm.gid , list, 1); |
231 | AV_STORE_IV(data->sem_perm.cuid, list, 2); |
232 | AV_STORE_IV(data->sem_perm.cgid, list, 3); |
233 | AV_STORE_IV(data->sem_perm.mode, list, 4); |
234 | AV_STORE_IV(data->sem_ctime , list, 5); |
235 | AV_STORE_IV(data->sem_otime , list, 6); |
236 | AV_STORE_IV(data->sem_nsems , list, 7); |
0ade1984 |
237 | XSRETURN(1); |
6087ac44 |
238 | #else |
8f85282b |
239 | croak(s_sysv_unimpl, "sem"); |
6087ac44 |
240 | #endif |
8f85282b |
241 | } |
242 | |
243 | |
244 | MODULE=IPC::SysV PACKAGE=IPC::SharedMem::stat |
245 | |
246 | PROTOTYPES: ENABLE |
0ade1984 |
247 | |
248 | void |
249 | pack(obj) |
250 | SV * obj |
251 | PPCODE: |
8f85282b |
252 | { |
253 | #ifdef HAS_SHM |
254 | AV *list = (AV*) SvRV(obj); |
255 | struct shmid_ds ds; |
256 | assert_sv_isa(obj, s_pkg_shm, "pack"); |
257 | AV_FETCH_IV(ds.shm_perm.uid , list, 0); |
258 | AV_FETCH_IV(ds.shm_perm.gid , list, 1); |
259 | AV_FETCH_IV(ds.shm_perm.cuid, list, 2); |
260 | AV_FETCH_IV(ds.shm_perm.cgid, list, 3); |
261 | AV_FETCH_IV(ds.shm_perm.mode, list, 4); |
262 | AV_FETCH_IV(ds.shm_segsz , list, 5); |
263 | AV_FETCH_IV(ds.shm_lpid , list, 6); |
264 | AV_FETCH_IV(ds.shm_cpid , list, 7); |
265 | AV_FETCH_IV(ds.shm_nattch , list, 8); |
266 | AV_FETCH_IV(ds.shm_atime , list, 9); |
267 | AV_FETCH_IV(ds.shm_dtime , list, 10); |
268 | AV_FETCH_IV(ds.shm_ctime , list, 11); |
269 | ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds))); |
0ade1984 |
270 | XSRETURN(1); |
6087ac44 |
271 | #else |
8f85282b |
272 | croak(s_sysv_unimpl, "shm"); |
6087ac44 |
273 | #endif |
8f85282b |
274 | } |
275 | |
276 | void |
277 | unpack(obj, ds) |
278 | SV * obj |
279 | SV * ds |
280 | PPCODE: |
281 | { |
282 | #ifdef HAS_SHM |
283 | AV *list = (AV*) SvRV(obj); |
284 | STRLEN len; |
285 | const struct shmid_ds *data = (struct shmid_ds *) SvPV_const(ds, len); |
286 | assert_sv_isa(obj, s_pkg_shm, "unpack"); |
287 | assert_data_length(s_pkg_shm, len, sizeof(*data)); |
288 | AV_STORE_IV(data->shm_perm.uid , list, 0); |
289 | AV_STORE_IV(data->shm_perm.gid , list, 1); |
290 | AV_STORE_IV(data->shm_perm.cuid, list, 2); |
291 | AV_STORE_IV(data->shm_perm.cgid, list, 3); |
292 | AV_STORE_IV(data->shm_perm.mode, list, 4); |
293 | AV_STORE_IV(data->shm_segsz , list, 5); |
294 | AV_STORE_IV(data->shm_lpid , list, 6); |
295 | AV_STORE_IV(data->shm_cpid , list, 7); |
296 | AV_STORE_IV(data->shm_nattch , list, 8); |
297 | AV_STORE_IV(data->shm_atime , list, 9); |
298 | AV_STORE_IV(data->shm_dtime , list, 10); |
299 | AV_STORE_IV(data->shm_ctime , list, 11); |
300 | XSRETURN(1); |
301 | #else |
302 | croak(s_sysv_unimpl, "shm"); |
303 | #endif |
304 | } |
305 | |
0ade1984 |
306 | |
307 | MODULE=IPC::SysV PACKAGE=IPC::SysV |
308 | |
8f85282b |
309 | PROTOTYPES: ENABLE |
310 | |
8063af02 |
311 | void |
8f85282b |
312 | ftok(path, id = &PL_sv_undef) |
313 | const char *path |
314 | SV *id |
315 | PREINIT: |
316 | int proj_id = 1; |
317 | key_t k; |
318 | CODE: |
0ade1984 |
319 | #if defined(HAS_SEM) || defined(HAS_SHM) |
8f85282b |
320 | if (SvOK(id)) |
321 | { |
322 | if (SvIOK(id)) |
323 | { |
324 | proj_id = (int) SvIVX(id); |
325 | } |
326 | else if (SvPOK(id) && SvCUR(id) == sizeof(char)) |
327 | { |
328 | proj_id = (int) *SvPVX(id); |
329 | } |
330 | else |
331 | { |
332 | croak("invalid project id"); |
333 | } |
334 | } |
899488ba |
335 | /* Including <sys/types.h> before <sys/ipc.h> makes Tru64 |
336 | * to see the obsolete prototype of ftok() first, grumble. */ |
337 | # ifdef __osf__ |
338 | # define Ftok_t char* |
339 | /* Configure TODO Ftok_t */ |
340 | # endif |
341 | # ifndef Ftok_t |
342 | # define Ftok_t const char* |
343 | # endif |
344 | k = ftok((Ftok_t)path, proj_id); |
8f85282b |
345 | ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k)); |
346 | XSRETURN(1); |
0ade1984 |
347 | #else |
8f85282b |
348 | Perl_die(aTHX_ PL_no_func, "ftok"); return; |
0ade1984 |
349 | #endif |
350 | |
8063af02 |
351 | void |
8f85282b |
352 | memread(addr, sv, pos, size) |
353 | SV *addr |
354 | SV *sv |
355 | int pos |
356 | int size |
357 | CODE: |
a7c93bfc |
358 | char *caddr = (char *) sv2addr(addr); |
8f85282b |
359 | char *dst; |
360 | if (!SvOK(sv)) |
361 | { |
362 | sv_setpvn(sv, "", 0); |
363 | } |
364 | SvPV_force_nolen(sv); |
365 | dst = SvGROW(sv, (STRLEN) size + 1); |
366 | Copy(caddr + pos, dst, size, char); |
367 | SvCUR_set(sv, size); |
368 | *SvEND(sv) = '\0'; |
369 | SvSETMAGIC(sv); |
370 | #ifndef INCOMPLETE_TAINTS |
371 | /* who knows who has been playing with this memory? */ |
372 | SvTAINTED_on(sv); |
373 | #endif |
374 | XSRETURN_YES; |
375 | |
376 | void |
377 | memwrite(addr, sv, pos, size) |
378 | SV *addr |
379 | SV *sv |
380 | int pos |
381 | int size |
382 | CODE: |
a7c93bfc |
383 | char *caddr = (char *) sv2addr(addr); |
8f85282b |
384 | STRLEN len; |
385 | const char *src = SvPV_const(sv, len); |
386 | int n = ((int) len > size) ? size : (int) len; |
387 | Copy(src, caddr + pos, n, char); |
388 | if (n < size) |
389 | { |
390 | memzero(caddr + pos + n, size - n); |
391 | } |
392 | XSRETURN_YES; |
393 | |
394 | void |
395 | shmat(id, addr, flag) |
396 | int id |
397 | SV *addr |
398 | int flag |
399 | CODE: |
400 | #ifdef HAS_SHM |
401 | void *caddr = SvOK(addr) ? sv2addr(addr) : NULL; |
402 | void *shm = (void *) shmat(id, caddr, flag); |
403 | ST(0) = shm == (void *) -1 ? &PL_sv_undef |
404 | : sv_2mortal(newSVpvn((char *) &shm, sizeof(void *))); |
405 | XSRETURN(1); |
0ade1984 |
406 | #else |
8f85282b |
407 | Perl_die(aTHX_ PL_no_func, "shmat"); return; |
0ade1984 |
408 | #endif |
409 | |
8f85282b |
410 | void |
411 | shmdt(addr) |
412 | SV *addr |
413 | CODE: |
414 | #ifdef HAS_SHM |
415 | void *caddr = sv2addr(addr); |
899488ba |
416 | int rv = shmdt((Shmat_t)caddr); |
8f85282b |
417 | ST(0) = rv == -1 ? &PL_sv_undef : sv_2mortal(newSViv(rv)); |
418 | XSRETURN(1); |
419 | #else |
420 | Perl_die(aTHX_ PL_no_func, "shmdt"); return; |
0ade1984 |
421 | #endif |
0ade1984 |
422 | |
8f85282b |
423 | INCLUDE: const-xs.inc |
0ade1984 |
424 | |