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 if (id >= 0) { 396 void *caddr = SvOK(addr) ? sv2addr(addr) : NULL; 397 void *shm = (void *) shmat(id, caddr, flag); 398 ST(0) = shm == (void *) -1 ? &PL_sv_undef 399 : sv_2mortal(newSVpvn((char *) &shm, sizeof(void *))); 400 } else { 401 SETERRNO(EINVAL,LIB_INVARG); 402 ST(0) = &PL_sv_undef; 403 } 404 XSRETURN(1); 405 #else 406 Perl_die(aTHX_ PL_no_func, "shmat"); return; 407 #endif 408 409 void 410 shmdt(addr) 411 SV *addr 412 CODE: 413 #ifdef HAS_SHM 414 void *caddr = sv2addr(addr); 415 int rv = shmdt((Shmat_t)caddr); 416 ST(0) = rv == -1 ? &PL_sv_undef : sv_2mortal(newSViv(rv)); 417 XSRETURN(1); 418 #else 419 Perl_die(aTHX_ PL_no_func, "shmdt"); return; 420 #endif 421 422 INCLUDE: const-xs.inc 423 424