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
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 #define NEED_sv_2pv_flags
16 #define NEED_sv_pvn_force_flags
17 #include "ppport.h"
18
19 #include <sys/types.h>
20
21 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
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
44 #endif
45
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
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__
55 #  include <vm/vm_param.h>      /* move upwards under HAS_SHM? */
56 #endif
57
58 #ifndef S_IRWXU
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
68 #endif
69
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
80 static const char *s_fmt_not_isa = "Method %s not called a %s object";
81 static const char *s_bad_length = "Bad arg length for %s, length is %d, should be %d";
82 static const char *s_sysv_unimpl PERL_UNUSED_DECL
83                                  = "System V %sxxx is not implemented on this machine";
84
85 static const char *s_pkg_msg = "IPC::Msg::stat";
86 static const char *s_pkg_sem = "IPC::Semaphore::stat";
87 static const char *s_pkg_shm = "IPC::SharedMem::stat";
88
89 static 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
101 static 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
109 static 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
120 MODULE=IPC::SysV        PACKAGE=IPC::Msg::stat
121
122 PROTOTYPES: ENABLE
123
124 void
125 pack(obj)
126     SV  * obj
127 PPCODE:
128   {
129 #ifdef HAS_MSG
130     AV *list = (AV*) SvRV(obj);
131     struct msqid_ds ds;
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)));
146     XSRETURN(1);
147 #else
148     croak(s_sysv_unimpl, "msg");
149 #endif
150   }
151
152 void
153 unpack(obj, ds)
154     SV * obj
155     SV * ds
156 PPCODE:
157   {
158 #ifdef HAS_MSG
159     AV *list = (AV*) SvRV(obj);
160     STRLEN len;
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);
176     XSRETURN(1);
177 #else
178     croak(s_sysv_unimpl, "msg");
179 #endif
180   }
181
182
183 MODULE=IPC::SysV        PACKAGE=IPC::Semaphore::stat
184
185 PROTOTYPES: ENABLE
186
187 void
188 pack(obj)
189     SV  * obj
190 PPCODE:
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
211 void
212 unpack(obj, ds)
213     SV * obj
214     SV * ds
215 PPCODE:
216   {
217 #ifdef HAS_SEM
218     AV *list = (AV*) SvRV(obj);
219     STRLEN len;
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);
231     XSRETURN(1);
232 #else
233     croak(s_sysv_unimpl, "sem");
234 #endif
235   }
236
237
238 MODULE=IPC::SysV        PACKAGE=IPC::SharedMem::stat
239
240 PROTOTYPES: ENABLE
241
242 void
243 pack(obj)
244     SV  * obj
245 PPCODE:
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)));
264     XSRETURN(1);
265 #else
266     croak(s_sysv_unimpl, "shm");
267 #endif
268   }
269
270 void
271 unpack(obj, ds)
272     SV * obj
273     SV * ds
274 PPCODE:
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
300
301 MODULE=IPC::SysV        PACKAGE=IPC::SysV
302
303 PROTOTYPES: ENABLE
304
305 void
306 ftok(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:
313 #if defined(HAS_SEM) || defined(HAS_SHM)
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     }
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);
339     ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k));
340     XSRETURN(1);
341 #else
342     Perl_die(aTHX_ PL_no_func, "ftok"); return;
343 #endif
344
345 void
346 memread(addr, sv, pos, size)
347     SV *addr
348     SV *sv
349     int pos
350     int size
351   CODE:
352     char *caddr = (char *) sv2addr(addr);
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
370 void
371 memwrite(addr, sv, pos, size)
372     SV *addr
373     SV *sv
374     int pos
375     int size
376   CODE:
377     char *caddr = (char *) sv2addr(addr);
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
388 void
389 shmat(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);
400 #else
401     Perl_die(aTHX_ PL_no_func, "shmat"); return;
402 #endif
403
404 void
405 shmdt(addr)
406     SV *addr
407   CODE:
408 #ifdef HAS_SHM
409     void *caddr = sv2addr(addr);
410     int rv = shmdt((Shmat_t)caddr);
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;
415 #endif
416
417 INCLUDE: const-xs.inc
418