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