cpan/IPC-SysV/SysV.xs

   1 /*******************************************************************************
   2 *
   3 *  $Revision: 33 $
   4 *  $Author: mhx $
   5 *  $Date: 2010/03/07 16:01:40 +0100 $
   6 *
   7 ********************************************************************************
   8 *
   9 *  Version 2.x, Copyright (C) 2007-2010, 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 /* Including <sys/types.h> before <sys/ipc.h> makes Tru64
 336  * to see the obsolete prototype of ftok() first, grumble. */
 337 # ifdef __osf__
 338 #  define Ftok_t char*
 339 /* Configure TODO Ftok_t */
 340 # endif
 341 # ifndef Ftok_t
 342 #  define Ftok_t const char*
 343 # endif
 344     k = ftok((Ftok_t)path, proj_id);
 345     ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k));
 346     XSRETURN(1);
 347 #else
 348     Perl_die(aTHX_ PL_no_func, "ftok"); return;
 349 #endif
 350
 351 void
 352 memread(addr, sv, pos, size)
 353     SV *addr
 354     SV *sv
 355     int pos
 356     int size
 357   CODE:
 358     char *caddr = (char *) sv2addr(addr);
 359     char *dst;
 360     if (!SvOK(sv))
 361     {
 362       sv_setpvn(sv, "", 0);
 363     }
 364     SvPV_force_nolen(sv);
 365     dst = SvGROW(sv, (STRLEN) size + 1);
 366     Copy(caddr + pos, dst, size, char);
 367     SvCUR_set(sv, size);
 368     *SvEND(sv) = '\0';
 369     SvSETMAGIC(sv);
 370 #ifndef INCOMPLETE_TAINTS
 371     /* who knows who has been playing with this memory? */
 372     SvTAINTED_on(sv);
 373 #endif
 374     XSRETURN_YES;
 375
 376 void
 377 memwrite(addr, sv, pos, size)
 378     SV *addr
 379     SV *sv
 380     int pos
 381     int size
 382   CODE:
 383     char *caddr = (char *) sv2addr(addr);
 384     STRLEN len;
 385     const char *src = SvPV_const(sv, len);
 386     int n = ((int) len > size) ? size : (int) len;
 387     Copy(src, caddr + pos, n, char);
 388     if (n < size)
 389     {
 390       memzero(caddr + pos + n, size - n);
 391     }
 392     XSRETURN_YES;
 393
 394 void
 395 shmat(id, addr, flag)
 396     int id
 397     SV *addr
 398     int flag
 399   CODE:
 400 #ifdef HAS_SHM
 401     void *caddr = SvOK(addr) ? sv2addr(addr) : NULL;
 402     void *shm = (void *) shmat(id, caddr, flag);
 403     ST(0) = shm == (void *) -1 ? &PL_sv_undef
 404                                : sv_2mortal(newSVpvn((char *) &shm, sizeof(void *)));
 405     XSRETURN(1);
 406 #else
 407     Perl_die(aTHX_ PL_no_func, "shmat"); return;
 408 #endif
 409
 410 void
 411 shmdt(addr)
 412     SV *addr
 413   CODE:
 414 #ifdef HAS_SHM
 415     void *caddr = sv2addr(addr);
 416     int rv = shmdt((Shmat_t)caddr);
 417     ST(0) = rv == -1 ? &PL_sv_undef : sv_2mortal(newSViv(rv));
 418     XSRETURN(1);
 419 #else
 420     Perl_die(aTHX_ PL_no_func, "shmdt"); return;
 421 #endif
 422
 423 INCLUDE: const-xs.inc
 424