[perl5.git] / cpan / IPC-SysV / SysV.xs

/*******************************************************************************
*
*  Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz <mhx@cpan.org>.
*  Version 1.x, Copyright (C) 1999, Graham Barr <gbarr@pobox.com>.
*
*  This program is free software; you can redistribute it and/or
*  modify it under the same terms as Perl itself.
*
*******************************************************************************/

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define NEED_sv_2pv_flags
#define NEED_sv_pvn_force_flags
#include "ppport.h"

#include <sys/types.h>

#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
#  ifndef HAS_SEM
#    include <sys/ipc.h>
#  endif
#  ifdef HAS_MSG
#    include <sys/msg.h>
#  endif
#  ifdef HAS_SHM
#    if defined(PERL_SCO) || defined(PERL_ISC)
#      include <sys/sysmacros.h>	/* SHMLBA */
#    endif
#    include <sys/shm.h>
#    ifndef HAS_SHMAT_PROTOTYPE
       extern Shmat_t shmat(int, char *, int);
#    endif
#    if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE)
#      undef  SHMLBA /* not static: determined at boot time */
#      define SHMLBA sysconf(_SC_PAGESIZE)
#    elif defined(HAS_GETPAGESIZE)
#      undef  SHMLBA /* not static: determined at boot time */
#      define SHMLBA getpagesize()
#    endif
#  endif
#endif

/* Required to get 'struct pte' for SHMLBA on ULTRIX. */
#if defined(__ultrix) || defined(__ultrix__) || defined(ultrix)
#include <machine/pte.h>
#endif

/* Required in BSDI to get PAGE_SIZE definition for SHMLBA.
 * Ugly.  More beautiful solutions welcome.
 * Shouting at BSDI sounds quite beautiful. */
#ifdef __bsdi__
#  include <vm/vm_param.h>	/* move upwards under HAS_SHM? */
#endif

#ifndef S_IRWXU
#  ifdef S_IRUSR
#    define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR)
#    define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP)
#    define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH)
#  else
#    define S_IRWXU 0700
#    define S_IRWXG 0070
#    define S_IRWXO 0007
#  endif
#endif

#define AV_FETCH_IV(ident, av, index)                         \
        STMT_START {                                          \
          SV **svp;                                           \
          if ((svp = av_fetch((av), (index), FALSE)) != NULL) \
            ident = SvIV(*svp);                               \
        } STMT_END

#define AV_STORE_IV(ident, av, index)                         \
          av_store((av), (index), newSViv(ident))

static const char *s_fmt_not_isa = "Method %s not called a %s object";
static const char *s_bad_length = "Bad arg length for %s, length is %d, should be %d";
static const char *s_sysv_unimpl PERL_UNUSED_DECL
                                 = "System V %sxxx is not implemented on this machine";

static const char *s_pkg_msg = "IPC::Msg::stat";
static const char *s_pkg_sem = "IPC::Semaphore::stat";
static const char *s_pkg_shm = "IPC::SharedMem::stat";

static void *sv2addr(SV *sv)
{
  if (SvPOK(sv) && SvCUR(sv) == sizeof(void *))
  {
    return *((void **) SvPVX(sv));
  }

  croak("invalid address value");

  return 0;
}

static void assert_sv_isa(SV *sv, const char *name, const char *method)
{
  if (!sv_isa(sv, name))
  {
    croak(s_fmt_not_isa, method, name);
  }
}

static void assert_data_length(const char *name, int got, int expected)
{
  if (got != expected)
  {
    croak(s_bad_length, name, got, expected);
  }
}

#include "const-c.inc"


MODULE=IPC::SysV	PACKAGE=IPC::Msg::stat

PROTOTYPES: ENABLE

void
pack(obj)
    SV	* obj
PPCODE:
  {
#ifdef HAS_MSG
    AV *list = (AV*) SvRV(obj);
    struct msqid_ds ds;
    assert_sv_isa(obj, s_pkg_msg, "pack");
    AV_FETCH_IV(ds.msg_perm.uid , list,  0);
    AV_FETCH_IV(ds.msg_perm.gid , list,  1);
    AV_FETCH_IV(ds.msg_perm.cuid, list,  2);
    AV_FETCH_IV(ds.msg_perm.cgid, list,  3);
    AV_FETCH_IV(ds.msg_perm.mode, list,  4);
    AV_FETCH_IV(ds.msg_qnum     , list,  5);
    AV_FETCH_IV(ds.msg_qbytes   , list,  6);
    AV_FETCH_IV(ds.msg_lspid    , list,  7);
    AV_FETCH_IV(ds.msg_lrpid    , list,  8);
    AV_FETCH_IV(ds.msg_stime    , list,  9);
    AV_FETCH_IV(ds.msg_rtime    , list, 10);
    AV_FETCH_IV(ds.msg_ctime    , list, 11);
    ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds)));
    XSRETURN(1);
#else
    croak(s_sysv_unimpl, "msg");
#endif
  }

void
unpack(obj, ds)
    SV * obj
    SV * ds
PPCODE:
  {
#ifdef HAS_MSG
    AV *list = (AV*) SvRV(obj);
    STRLEN len;
    const struct msqid_ds *data = (struct msqid_ds *) SvPV_const(ds, len);
    assert_sv_isa(obj, s_pkg_msg, "unpack");
    assert_data_length(s_pkg_msg, len, sizeof(*data));
    AV_STORE_IV(data->msg_perm.uid , list,  0);
    AV_STORE_IV(data->msg_perm.gid , list,  1);
    AV_STORE_IV(data->msg_perm.cuid, list,  2);
    AV_STORE_IV(data->msg_perm.cgid, list,  3);
    AV_STORE_IV(data->msg_perm.mode, list,  4);
    AV_STORE_IV(data->msg_qnum     , list,  5);
    AV_STORE_IV(data->msg_qbytes   , list,  6);
    AV_STORE_IV(data->msg_lspid    , list,  7);
    AV_STORE_IV(data->msg_lrpid    , list,  8);
    AV_STORE_IV(data->msg_stime    , list,  9);
    AV_STORE_IV(data->msg_rtime    , list, 10);
    AV_STORE_IV(data->msg_ctime    , list, 11);
    XSRETURN(1);
#else
    croak(s_sysv_unimpl, "msg");
#endif
  }


MODULE=IPC::SysV	PACKAGE=IPC::Semaphore::stat

PROTOTYPES: ENABLE

void
pack(obj)
    SV	* obj
PPCODE:
  {
#ifdef HAS_SEM
    AV *list = (AV*) SvRV(obj);
    struct semid_ds ds;
    assert_sv_isa(obj, s_pkg_sem, "pack");
    AV_FETCH_IV(ds.sem_perm.uid , list, 0);
    AV_FETCH_IV(ds.sem_perm.gid , list, 1);
    AV_FETCH_IV(ds.sem_perm.cuid, list, 2);
    AV_FETCH_IV(ds.sem_perm.cgid, list, 3);
    AV_FETCH_IV(ds.sem_perm.mode, list, 4);
    AV_FETCH_IV(ds.sem_ctime    , list, 5);
    AV_FETCH_IV(ds.sem_otime    , list, 6);
    AV_FETCH_IV(ds.sem_nsems    , list, 7);
    ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds)));
    XSRETURN(1);
#else
    croak(s_sysv_unimpl, "sem");
#endif
  }

void
unpack(obj, ds)
    SV * obj
    SV * ds
PPCODE:
  {
#ifdef HAS_SEM
    AV *list = (AV*) SvRV(obj);
    STRLEN len;
    const struct semid_ds *data = (struct semid_ds *) SvPV_const(ds, len);
    assert_sv_isa(obj, s_pkg_sem, "unpack");
    assert_data_length(s_pkg_sem, len, sizeof(*data));
    AV_STORE_IV(data->sem_perm.uid , list, 0);
    AV_STORE_IV(data->sem_perm.gid , list, 1);
    AV_STORE_IV(data->sem_perm.cuid, list, 2);
    AV_STORE_IV(data->sem_perm.cgid, list, 3);
    AV_STORE_IV(data->sem_perm.mode, list, 4);
    AV_STORE_IV(data->sem_ctime    , list, 5);
    AV_STORE_IV(data->sem_otime    , list, 6);
    AV_STORE_IV(data->sem_nsems    , list, 7);
    XSRETURN(1);
#else
    croak(s_sysv_unimpl, "sem");
#endif
  }


MODULE=IPC::SysV	PACKAGE=IPC::SharedMem::stat

PROTOTYPES: ENABLE

void
pack(obj)
    SV	* obj
PPCODE:
  {
#ifdef HAS_SHM
    AV *list = (AV*) SvRV(obj);
    struct shmid_ds ds;
    assert_sv_isa(obj, s_pkg_shm, "pack");
    AV_FETCH_IV(ds.shm_perm.uid , list,  0);
    AV_FETCH_IV(ds.shm_perm.gid , list,  1);
    AV_FETCH_IV(ds.shm_perm.cuid, list,  2);
    AV_FETCH_IV(ds.shm_perm.cgid, list,  3);
    AV_FETCH_IV(ds.shm_perm.mode, list,  4);
    AV_FETCH_IV(ds.shm_segsz    , list,  5);
    AV_FETCH_IV(ds.shm_lpid     , list,  6);
    AV_FETCH_IV(ds.shm_cpid     , list,  7);
    AV_FETCH_IV(ds.shm_nattch   , list,  8);
    AV_FETCH_IV(ds.shm_atime    , list,  9);
    AV_FETCH_IV(ds.shm_dtime    , list, 10);
    AV_FETCH_IV(ds.shm_ctime    , list, 11);
    ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds)));
    XSRETURN(1);
#else
    croak(s_sysv_unimpl, "shm");
#endif
  }

void
unpack(obj, ds)
    SV * obj
    SV * ds
PPCODE:
  {
#ifdef HAS_SHM
    AV *list = (AV*) SvRV(obj);
    STRLEN len;
    const struct shmid_ds *data = (struct shmid_ds *) SvPV_const(ds, len);
    assert_sv_isa(obj, s_pkg_shm, "unpack");
    assert_data_length(s_pkg_shm, len, sizeof(*data));
    AV_STORE_IV(data->shm_perm.uid , list,  0);
    AV_STORE_IV(data->shm_perm.gid , list,  1);
    AV_STORE_IV(data->shm_perm.cuid, list,  2);
    AV_STORE_IV(data->shm_perm.cgid, list,  3);
    AV_STORE_IV(data->shm_perm.mode, list,  4);
    AV_STORE_IV(data->shm_segsz    , list,  5);
    AV_STORE_IV(data->shm_lpid     , list,  6);
    AV_STORE_IV(data->shm_cpid     , list,  7);
    AV_STORE_IV(data->shm_nattch   , list,  8);
    AV_STORE_IV(data->shm_atime    , list,  9);
    AV_STORE_IV(data->shm_dtime    , list, 10);
    AV_STORE_IV(data->shm_ctime    , list, 11);
    XSRETURN(1);
#else
    croak(s_sysv_unimpl, "shm");
#endif
  }


MODULE=IPC::SysV	PACKAGE=IPC::SysV

PROTOTYPES: ENABLE

void
ftok(path, id = &PL_sv_undef)
    const char *path
    SV *id
  PREINIT:
    int proj_id = 1;
    key_t k;
  CODE:
#if defined(HAS_SEM) || defined(HAS_SHM)
    if (SvOK(id))
    {
      if (SvIOK(id))
      {
        proj_id = (int) SvIVX(id);
      }
      else if (SvPOK(id) && SvCUR(id) == sizeof(char))
      {
        proj_id = (int) *SvPVX(id);
      }
      else
      {
        croak("invalid project id");
      }
    }
/* Including <sys/types.h> before <sys/ipc.h> makes Tru64
 * to see the obsolete prototype of ftok() first, grumble. */
# ifdef __osf__
#  define Ftok_t char*
/* Configure TODO Ftok_t */
# endif 
# ifndef Ftok_t
#  define Ftok_t const char*
# endif
    k = ftok((Ftok_t)path, proj_id);
    ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k));
    XSRETURN(1);
#else
    Perl_die(aTHX_ PL_no_func, "ftok"); return;
#endif

void
memread(addr, sv, pos, size)
    SV *addr
    SV *sv
    int pos
    int size
  CODE:
    char *caddr = (char *) sv2addr(addr);
    char *dst;
    if (!SvOK(sv))
    {
      sv_setpvn(sv, "", 0);
    }
    SvPV_force_nolen(sv);
    dst = SvGROW(sv, (STRLEN) size + 1);
    Copy(caddr + pos, dst, size, char);
    SvCUR_set(sv, size);
    *SvEND(sv) = '\0';
    SvSETMAGIC(sv);
#ifndef INCOMPLETE_TAINTS
    /* who knows who has been playing with this memory? */
    SvTAINTED_on(sv);
#endif
    XSRETURN_YES;

void
memwrite(addr, sv, pos, size)
    SV *addr
    SV *sv
    int pos
    int size
  CODE:
    char *caddr = (char *) sv2addr(addr);
    STRLEN len;
    const char *src = SvPV_const(sv, len);
    int n = ((int) len > size) ? size : (int) len;
    Copy(src, caddr + pos, n, char);
    if (n < size)
    {
      memzero(caddr + pos + n, size - n);
    }
    XSRETURN_YES;

void
shmat(id, addr, flag)
    int id
    SV *addr
    int flag
  CODE:
#ifdef HAS_SHM
    void *caddr = SvOK(addr) ? sv2addr(addr) : NULL;
    void *shm = (void *) shmat(id, caddr, flag);
    ST(0) = shm == (void *) -1 ? &PL_sv_undef
                               : sv_2mortal(newSVpvn((char *) &shm, sizeof(void *)));
    XSRETURN(1);
#else
    Perl_die(aTHX_ PL_no_func, "shmat"); return;
#endif

void
shmdt(addr)
    SV *addr
  CODE:
#ifdef HAS_SHM
    void *caddr = sv2addr(addr);
    int rv = shmdt((Shmat_t)caddr);
    ST(0) = rv == -1 ? &PL_sv_undef : sv_2mortal(newSViv(rv));
    XSRETURN(1);
#else
    Perl_die(aTHX_ PL_no_func, "shmdt"); return;
#endif

INCLUDE: const-xs.inc
Commit	Line	Data
8f85282b MHM	1	/*******************************************************************************
8f85282b MHM	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
0ade1984 JH	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
1e509ade JH	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
85ab1d1d JH	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
	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
0ade1984 JH	120	MODULE=IPC::SysV PACKAGE=IPC::Msg::stat
	121
	122	PROTOTYPES: ENABLE
	123
	124	void
	125	pack(obj)
	126	SV * obj
	127	PPCODE:
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
0ade1984 JH	152	void
8f85282b	153	unpack(obj, ds)
0ade1984	154	SV * obj
8f85282b	155	SV * ds
0ade1984	156	PPCODE:
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	}
8f85282b MHM	181
0ade1984 JH	182
	183	MODULE=IPC::SysV PACKAGE=IPC::Semaphore::stat
	184
8f85282b MHM	185	PROTOTYPES: ENABLE
8f85282b MHM	186
0ade1984	187	void
8f85282b MHM	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)
0ade1984 JH	213	SV * obj
	214	SV * ds
	215	PPCODE:
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
	238	MODULE=IPC::SysV PACKAGE=IPC::SharedMem::stat
	239
	240	PROTOTYPES: ENABLE
0ade1984 JH	241
	242	void
	243	pack(obj)
	244	SV * obj
	245	PPCODE:
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
	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
0ade1984 JH	300
	301	MODULE=IPC::SysV PACKAGE=IPC::SysV
	302
8f85282b MHM	303	PROTOTYPES: ENABLE
8f85282b MHM	304
8063af02	305	void
8f85282b MHM	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:
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));
8f85282b MHM	340	XSRETURN(1);
0ade1984	341	#else
8f85282b	342	Perl_die(aTHX_ PL_no_func, "ftok"); return;
0ade1984 JH	343	#endif
0ade1984 JH	344
8063af02	345	void
8f85282b MHM	346	memread(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
	370	void
	371	memwrite(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
	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);
0ade1984	400	#else
8f85282b	401	Perl_die(aTHX_ PL_no_func, "shmat"); return;
0ade1984 JH	402	#endif
0ade1984 JH	403
8f85282b MHM	404	void
	405	shmdt(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	417	INCLUDE: const-xs.inc
0ade1984	418