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#ifndef NO_PPPORT_H 16# define NEED_sv_2pv_flags 17# define NEED_sv_pvn_force_flags 18# include "ppport.h" 19#endif 20 21#include <sys/types.h> 22 23#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) 24# ifndef HAS_SEM 25# include <sys/ipc.h> 26# endif 27# ifdef HAS_MSG 28# include <sys/msg.h> 29# endif 30# ifdef HAS_SHM 31# if defined(PERL_SCO) || defined(PERL_ISC) 32# include <sys/sysmacros.h> /* SHMLBA */ 33# endif 34# include <sys/shm.h> 35# ifndef HAS_SHMAT_PROTOTYPE 36 extern Shmat_t shmat(int, char *, int); 37# endif 38# if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE) 39# undef SHMLBA /* not static: determined at boot time */ 40# define SHMLBA sysconf(_SC_PAGESIZE) 41# elif defined(HAS_GETPAGESIZE) 42# undef SHMLBA /* not static: determined at boot time */ 43# define SHMLBA getpagesize() 44# endif 45# endif 46#endif 47 48/* Required to get 'struct pte' for SHMLBA on ULTRIX. */ 49#if defined(__ultrix) || defined(__ultrix__) || defined(ultrix) 50#include <machine/pte.h> 51#endif 52 53/* Required in BSDI to get PAGE_SIZE definition for SHMLBA. 54 * Ugly. More beautiful solutions welcome. 55 * Shouting at BSDI sounds quite beautiful. */ 56#ifdef __bsdi__ 57# include <vm/vm_param.h> /* move upwards under HAS_SHM? */ 58#endif 59 60#ifndef S_IRWXU 61# ifdef S_IRUSR 62# define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) 63# define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) 64# define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) 65# else 66# define S_IRWXU 0700 67# define S_IRWXG 0070 68# define S_IRWXO 0007 69# endif 70#endif 71 72#define AV_FETCH_IV(ident, av, index) \ 73 STMT_START { \ 74 SV **svp; \ 75 if ((svp = av_fetch((av), (index), FALSE)) != NULL) \ 76 ident = SvIV(*svp); \ 77 } STMT_END 78 79#define AV_STORE_IV(ident, av, index) \ 80 av_store((av), (index), newSViv(ident)) 81 82static const char *s_fmt_not_isa = "Method %s not called a %s object"; 83static const char *s_bad_length = "Bad arg length for %s, length is %d, should be %d"; 84static const char *s_sysv_unimpl PERL_UNUSED_DECL 85 = "System V %sxxx is not implemented on this machine"; 86 87static const char *s_pkg_msg = "IPC::Msg::stat"; 88static const char *s_pkg_sem = "IPC::Semaphore::stat"; 89static const char *s_pkg_shm = "IPC::SharedMem::stat"; 90 91static void *sv2addr(SV *sv) 92{ 93 if (SvPOK(sv) && SvCUR(sv) == sizeof(void *)) 94 { 95 return *((void **) SvPVX(sv)); 96 } 97 98 croak("invalid address value"); 99 100 return 0; 101} 102 103static void assert_sv_isa(SV *sv, const char *name, const char *method) 104{ 105 if (!sv_isa(sv, name)) 106 { 107 croak(s_fmt_not_isa, method, name); 108 } 109} 110 111static void assert_data_length(const char *name, int got, int expected) 112{ 113 if (got != expected) 114 { 115 croak(s_bad_length, name, got, expected); 116 } 117} 118 119#include "const-c.inc" 120 121 122MODULE=IPC::SysV PACKAGE=IPC::Msg::stat 123 124PROTOTYPES: ENABLE 125 126void 127pack(obj) 128 SV * obj 129PPCODE: 130 { 131#ifdef HAS_MSG 132 AV *list = (AV*) SvRV(obj); 133 struct msqid_ds ds; 134 assert_sv_isa(obj, s_pkg_msg, "pack"); 135 AV_FETCH_IV(ds.msg_perm.uid , list, 0); 136 AV_FETCH_IV(ds.msg_perm.gid , list, 1); 137 AV_FETCH_IV(ds.msg_perm.cuid, list, 2); 138 AV_FETCH_IV(ds.msg_perm.cgid, list, 3); 139 AV_FETCH_IV(ds.msg_perm.mode, list, 4); 140 AV_FETCH_IV(ds.msg_qnum , list, 5); 141 AV_FETCH_IV(ds.msg_qbytes , list, 6); 142 AV_FETCH_IV(ds.msg_lspid , list, 7); 143 AV_FETCH_IV(ds.msg_lrpid , list, 8); 144 AV_FETCH_IV(ds.msg_stime , list, 9); 145 AV_FETCH_IV(ds.msg_rtime , list, 10); 146 AV_FETCH_IV(ds.msg_ctime , list, 11); 147 ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds))); 148 XSRETURN(1); 149#else 150 croak(s_sysv_unimpl, "msg"); 151#endif 152 } 153 154void 155unpack(obj, ds) 156 SV * obj 157 SV * ds 158PPCODE: 159 { 160#ifdef HAS_MSG 161 AV *list = (AV*) SvRV(obj); 162 STRLEN len; 163 const struct msqid_ds *data = (struct msqid_ds *) SvPV_const(ds, len); 164 assert_sv_isa(obj, s_pkg_msg, "unpack"); 165 assert_data_length(s_pkg_msg, len, sizeof(*data)); 166 AV_STORE_IV(data->msg_perm.uid , list, 0); 167 AV_STORE_IV(data->msg_perm.gid , list, 1); 168 AV_STORE_IV(data->msg_perm.cuid, list, 2); 169 AV_STORE_IV(data->msg_perm.cgid, list, 3); 170 AV_STORE_IV(data->msg_perm.mode, list, 4); 171 AV_STORE_IV(data->msg_qnum , list, 5); 172 AV_STORE_IV(data->msg_qbytes , list, 6); 173 AV_STORE_IV(data->msg_lspid , list, 7); 174 AV_STORE_IV(data->msg_lrpid , list, 8); 175 AV_STORE_IV(data->msg_stime , list, 9); 176 AV_STORE_IV(data->msg_rtime , list, 10); 177 AV_STORE_IV(data->msg_ctime , list, 11); 178 XSRETURN(1); 179#else 180 croak(s_sysv_unimpl, "msg"); 181#endif 182 } 183 184 185MODULE=IPC::SysV PACKAGE=IPC::Semaphore::stat 186 187PROTOTYPES: ENABLE 188 189void 190pack(obj) 191 SV * obj 192PPCODE: 193 { 194#ifdef HAS_SEM 195 AV *list = (AV*) SvRV(obj); 196 struct semid_ds ds; 197 assert_sv_isa(obj, s_pkg_sem, "pack"); 198 AV_FETCH_IV(ds.sem_perm.uid , list, 0); 199 AV_FETCH_IV(ds.sem_perm.gid , list, 1); 200 AV_FETCH_IV(ds.sem_perm.cuid, list, 2); 201 AV_FETCH_IV(ds.sem_perm.cgid, list, 3); 202 AV_FETCH_IV(ds.sem_perm.mode, list, 4); 203 AV_FETCH_IV(ds.sem_ctime , list, 5); 204 AV_FETCH_IV(ds.sem_otime , list, 6); 205 AV_FETCH_IV(ds.sem_nsems , list, 7); 206 ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds))); 207 XSRETURN(1); 208#else 209 croak(s_sysv_unimpl, "sem"); 210#endif 211 } 212 213void 214unpack(obj, ds) 215 SV * obj 216 SV * ds 217PPCODE: 218 { 219#ifdef HAS_SEM 220 AV *list = (AV*) SvRV(obj); 221 STRLEN len; 222 const struct semid_ds *data = (struct semid_ds *) SvPV_const(ds, len); 223 assert_sv_isa(obj, s_pkg_sem, "unpack"); 224 assert_data_length(s_pkg_sem, len, sizeof(*data)); 225 AV_STORE_IV(data->sem_perm.uid , list, 0); 226 AV_STORE_IV(data->sem_perm.gid , list, 1); 227 AV_STORE_IV(data->sem_perm.cuid, list, 2); 228 AV_STORE_IV(data->sem_perm.cgid, list, 3); 229 AV_STORE_IV(data->sem_perm.mode, list, 4); 230 AV_STORE_IV(data->sem_ctime , list, 5); 231 AV_STORE_IV(data->sem_otime , list, 6); 232 AV_STORE_IV(data->sem_nsems , list, 7); 233 XSRETURN(1); 234#else 235 croak(s_sysv_unimpl, "sem"); 236#endif 237 } 238 239 240MODULE=IPC::SysV PACKAGE=IPC::SharedMem::stat 241 242PROTOTYPES: ENABLE 243 244void 245pack(obj) 246 SV * obj 247PPCODE: 248 { 249#ifdef HAS_SHM 250 AV *list = (AV*) SvRV(obj); 251 struct shmid_ds ds; 252 assert_sv_isa(obj, s_pkg_shm, "pack"); 253 AV_FETCH_IV(ds.shm_perm.uid , list, 0); 254 AV_FETCH_IV(ds.shm_perm.gid , list, 1); 255 AV_FETCH_IV(ds.shm_perm.cuid, list, 2); 256 AV_FETCH_IV(ds.shm_perm.cgid, list, 3); 257 AV_FETCH_IV(ds.shm_perm.mode, list, 4); 258 AV_FETCH_IV(ds.shm_segsz , list, 5); 259 AV_FETCH_IV(ds.shm_lpid , list, 6); 260 AV_FETCH_IV(ds.shm_cpid , list, 7); 261 AV_FETCH_IV(ds.shm_nattch , list, 8); 262 AV_FETCH_IV(ds.shm_atime , list, 9); 263 AV_FETCH_IV(ds.shm_dtime , list, 10); 264 AV_FETCH_IV(ds.shm_ctime , list, 11); 265 ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds))); 266 XSRETURN(1); 267#else 268 croak(s_sysv_unimpl, "shm"); 269#endif 270 } 271 272void 273unpack(obj, ds) 274 SV * obj 275 SV * ds 276PPCODE: 277 { 278#ifdef HAS_SHM 279 AV *list = (AV*) SvRV(obj); 280 STRLEN len; 281 const struct shmid_ds *data = (struct shmid_ds *) SvPV_const(ds, len); 282 assert_sv_isa(obj, s_pkg_shm, "unpack"); 283 assert_data_length(s_pkg_shm, len, sizeof(*data)); 284 AV_STORE_IV(data->shm_perm.uid , list, 0); 285 AV_STORE_IV(data->shm_perm.gid , list, 1); 286 AV_STORE_IV(data->shm_perm.cuid, list, 2); 287 AV_STORE_IV(data->shm_perm.cgid, list, 3); 288 AV_STORE_IV(data->shm_perm.mode, list, 4); 289 AV_STORE_IV(data->shm_segsz , list, 5); 290 AV_STORE_IV(data->shm_lpid , list, 6); 291 AV_STORE_IV(data->shm_cpid , list, 7); 292 AV_STORE_IV(data->shm_nattch , list, 8); 293 AV_STORE_IV(data->shm_atime , list, 9); 294 AV_STORE_IV(data->shm_dtime , list, 10); 295 AV_STORE_IV(data->shm_ctime , list, 11); 296 XSRETURN(1); 297#else 298 croak(s_sysv_unimpl, "shm"); 299#endif 300 } 301 302 303MODULE=IPC::SysV PACKAGE=IPC::SysV 304 305PROTOTYPES: ENABLE 306 307void 308ftok(path, id = &PL_sv_undef) 309 const char *path 310 SV *id 311 PREINIT: 312 int proj_id = 1; 313 key_t k; 314 CODE: 315#if defined(HAS_SEM) || defined(HAS_SHM) 316 if (SvOK(id)) 317 { 318 if (SvIOK(id)) 319 { 320 proj_id = (int) SvIVX(id); 321 } 322 else if (SvPOK(id) && SvCUR(id) == sizeof(char)) 323 { 324 proj_id = (int) *SvPVX(id); 325 } 326 else 327 { 328 croak("invalid project id"); 329 } 330 } 331/* Including <sys/types.h> before <sys/ipc.h> makes Tru64 332 * to see the obsolete prototype of ftok() first, grumble. */ 333# ifdef __osf__ 334# define Ftok_t char* 335/* Configure TODO Ftok_t */ 336# endif 337# ifndef Ftok_t 338# define Ftok_t const char* 339# endif 340 k = ftok((Ftok_t)path, proj_id); 341 ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k)); 342 XSRETURN(1); 343#else 344 Perl_die(aTHX_ PL_no_func, "ftok"); return; 345#endif 346 347void 348memread(addr, sv, pos, size) 349 SV *addr 350 SV *sv 351 UV pos 352 UV size 353 CODE: 354 char *caddr = (char *) sv2addr(addr); 355 char *dst; 356 if (!SvOK(sv)) 357 { 358 sv_setpvn(sv, "", 0); 359 } 360 SvPV_force_nolen(sv); 361 dst = SvGROW(sv, (STRLEN) size + 1); 362 Copy(caddr + pos, dst, size, char); 363 SvCUR_set(sv, size); 364 *SvEND(sv) = '\0'; 365 SvSETMAGIC(sv); 366#ifndef INCOMPLETE_TAINTS 367 /* who knows who has been playing with this memory? */ 368 SvTAINTED_on(sv); 369#endif 370 XSRETURN_YES; 371 372void 373memwrite(addr, sv, pos, size) 374 SV *addr 375 SV *sv 376 UV pos 377 UV size 378 CODE: 379 char *caddr = (char *) sv2addr(addr); 380 STRLEN len; 381 const char *src = SvPV_const(sv, len); 382 unsigned int n = ((unsigned int) len > size) ? size : (unsigned int) len; 383 Copy(src, caddr + pos, n, char); 384 if (n < size) 385 { 386 memzero(caddr + pos + n, size - n); 387 } 388 XSRETURN_YES; 389 390void 391shmat(id, addr, flag) 392 int id 393 SV *addr 394 int flag 395 CODE: 396#ifdef HAS_SHM 397 if (id >= 0) { 398 void *caddr = SvOK(addr) ? sv2addr(addr) : NULL; 399 void *shm = (void *) shmat(id, caddr, flag); 400 ST(0) = shm == (void *) -1 ? &PL_sv_undef 401 : sv_2mortal(newSVpvn((char *) &shm, sizeof(void *))); 402 } else { 403 SETERRNO(EINVAL,LIB_INVARG); 404 ST(0) = &PL_sv_undef; 405 } 406 XSRETURN(1); 407#else 408 Perl_die(aTHX_ PL_no_func, "shmat"); return; 409#endif 410 411void 412shmdt(addr) 413 SV *addr 414 CODE: 415#ifdef HAS_SHM 416 void *caddr = sv2addr(addr); 417 int rv = shmdt((Shmat_t)caddr); 418 ST(0) = rv == -1 ? &PL_sv_undef : sv_2mortal(newSViv(rv)); 419 XSRETURN(1); 420#else 421 Perl_die(aTHX_ PL_no_func, "shmdt"); return; 422#endif 423 424INCLUDE: const-xs.inc 425 426