This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fb1ec775ff3772e8adfbfca09261b337658d9ae6
[perl5.git] / ext / IPC / SysV / SysV.xs
1 /*******************************************************************************
2 *
3 *  $Revision: 31 $
4 *  $Author: mhx $
5 *  $Date: 2007/12/29 19:46:18 +0100 $
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
17 #include "EXTERN.h"
18 #include "perl.h"
19 #include "XSUB.h"
20
21 #define NEED_sv_2pv_flags
22 #define NEED_sv_pvn_force_flags
23 #include "ppport.h"
24
25 #include <sys/types.h>
26
27 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
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
50 #endif
51
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
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__
61 #  include <vm/vm_param.h>      /* move upwards under HAS_SHM? */
62 #endif
63
64 #ifndef S_IRWXU
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
74 #endif
75
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
126 MODULE=IPC::SysV        PACKAGE=IPC::Msg::stat
127
128 PROTOTYPES: ENABLE
129
130 void
131 pack(obj)
132     SV  * obj
133 PPCODE:
134   {
135 #ifdef HAS_MSG
136     AV *list = (AV*) SvRV(obj);
137     struct msqid_ds ds;
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)));
152     XSRETURN(1);
153 #else
154     croak(s_sysv_unimpl, "msg");
155 #endif
156   }
157
158 void
159 unpack(obj, ds)
160     SV * obj
161     SV * ds
162 PPCODE:
163   {
164 #ifdef HAS_MSG
165     AV *list = (AV*) SvRV(obj);
166     STRLEN len;
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);
182     XSRETURN(1);
183 #else
184     croak(s_sysv_unimpl, "msg");
185 #endif
186   }
187
188
189 MODULE=IPC::SysV        PACKAGE=IPC::Semaphore::stat
190
191 PROTOTYPES: ENABLE
192
193 void
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)
219     SV * obj
220     SV * ds
221 PPCODE:
222   {
223 #ifdef HAS_SEM
224     AV *list = (AV*) SvRV(obj);
225     STRLEN len;
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);
237     XSRETURN(1);
238 #else
239     croak(s_sysv_unimpl, "sem");
240 #endif
241   }
242
243
244 MODULE=IPC::SysV        PACKAGE=IPC::SharedMem::stat
245
246 PROTOTYPES: ENABLE
247
248 void
249 pack(obj)
250     SV  * obj
251 PPCODE:
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)));
270     XSRETURN(1);
271 #else
272     croak(s_sysv_unimpl, "shm");
273 #endif
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
306
307 MODULE=IPC::SysV        PACKAGE=IPC::SysV
308
309 PROTOTYPES: ENABLE
310
311 void
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:
319 #if defined(HAS_SEM) || defined(HAS_SHM)
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     }
335
336     k = ftok(path, proj_id);
337     ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k));
338     XSRETURN(1);
339 #else
340     Perl_die(aTHX_ PL_no_func, "ftok"); return;
341 #endif
342
343 void
344 memread(addr, sv, pos, size)
345     SV *addr
346     SV *sv
347     int pos
348     int size
349   CODE:
350     char *caddr = (char *) sv2addr(addr);
351     char *dst;
352     if (!SvOK(sv))
353     {
354       sv_setpvn(sv, "", 0);
355     }
356     SvPV_force_nolen(sv);
357     dst = SvGROW(sv, (STRLEN) size + 1);
358     Copy(caddr + pos, dst, size, char);
359     SvCUR_set(sv, size);
360     *SvEND(sv) = '\0';
361     SvSETMAGIC(sv);
362 #ifndef INCOMPLETE_TAINTS
363     /* who knows who has been playing with this memory? */
364     SvTAINTED_on(sv);
365 #endif
366     XSRETURN_YES;
367
368 void
369 memwrite(addr, sv, pos, size)
370     SV *addr
371     SV *sv
372     int pos
373     int size
374   CODE:
375     char *caddr = (char *) sv2addr(addr);
376     STRLEN len;
377     const char *src = SvPV_const(sv, len);
378     int n = ((int) len > size) ? size : (int) len;
379     Copy(src, caddr + pos, n, char);
380     if (n < size)
381     {
382       memzero(caddr + pos + n, size - n);
383     }
384     XSRETURN_YES;
385
386 void
387 shmat(id, addr, flag)
388     int id
389     SV *addr
390     int flag
391   CODE:
392 #ifdef HAS_SHM
393     void *caddr = SvOK(addr) ? sv2addr(addr) : NULL;
394     void *shm = (void *) shmat(id, caddr, flag);
395     ST(0) = shm == (void *) -1 ? &PL_sv_undef
396                                : sv_2mortal(newSVpvn((char *) &shm, sizeof(void *)));
397     XSRETURN(1);
398 #else
399     Perl_die(aTHX_ PL_no_func, "shmat"); return;
400 #endif
401
402 void
403 shmdt(addr)
404     SV *addr
405   CODE:
406 #ifdef HAS_SHM
407     void *caddr = sv2addr(addr);
408 #   ifdef __SUNPRO_CC
409     int rv = shmdt((char *)caddr);
410 #   else
411     int rv = shmdt(caddr);
412 #   endif
413     ST(0) = rv == -1 ? &PL_sv_undef : sv_2mortal(newSViv(rv));
414     XSRETURN(1);
415 #else
416     Perl_die(aTHX_ PL_no_func, "shmdt"); return;
417 #endif
418
419 INCLUDE: const-xs.inc
420