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