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