1 #define INCL_DOS 2 #define INCL_NOPM 3 #define INCL_DOSFILEMGR 4 #ifndef NO_SYS_ALLOC 5 # define INCL_DOSMEMMGR 6 # define INCL_DOSERRORS 7 #endif /* ! defined NO_SYS_ALLOC */ 8 #include <os2.h> 9 10 /* 11 * Various Unix compatibility functions for OS/2 12 */ 13 14 #include <stdio.h> 15 #include <errno.h> 16 #include <limits.h> 17 #include <process.h> 18 19 #include "EXTERN.h" 20 #include "perl.h" 21 22 /*****************************************************************************/ 23 /* priorities */ 24 25 int setpriority(int which, int pid, int val) 26 { 27 return DosSetPriority((pid < 0) ? PRTYS_PROCESSTREE : PRTYS_PROCESS, 28 val >> 8, val & 0xFF, abs(pid)); 29 } 30 31 int getpriority(int which /* ignored */, int pid) 32 { 33 TIB *tib; 34 PIB *pib; 35 DosGetInfoBlocks(&tib, &pib); 36 return tib->tib_ptib2->tib2_ulpri; 37 } 38 39 /*****************************************************************************/ 40 /* spawn */ 41 42 static int 43 result(int flag, int pid) 44 { 45 int r, status; 46 Signal_t (*ihand)(); /* place to save signal during system() */ 47 Signal_t (*qhand)(); /* place to save signal during system() */ 48 49 if (pid < 0 || flag != 0) 50 return pid; 51 52 ihand = signal(SIGINT, SIG_IGN); 53 qhand = signal(SIGQUIT, SIG_IGN); 54 do { 55 r = wait4pid(pid, &status, 0); 56 } while (r == -1 && errno == EINTR); 57 signal(SIGINT, ihand); 58 signal(SIGQUIT, qhand); 59 60 statusvalue = (U16)status; 61 if (r < 0) 62 return -1; 63 return status & 0xFFFF; 64 } 65 66 int 67 do_aspawn(really,mark,sp) 68 SV *really; 69 register SV **mark; 70 register SV **sp; 71 { 72 register char **a; 73 char *tmps; 74 int rc; 75 int flag = P_WAIT, trueflag; 76 77 if (sp > mark) { 78 New(401,Argv, sp - mark + 1, char*); 79 a = Argv; 80 81 if (mark < sp && SvIOKp(*(mark+1))) { 82 ++mark; 83 flag = SvIVx(*mark); 84 } 85 86 while (++mark <= sp) { 87 if (*mark) 88 *a++ = SvPVx(*mark, na); 89 else 90 *a++ = ""; 91 } 92 *a = Nullch; 93 94 trueflag = flag; 95 if (flag == P_WAIT) 96 flag = P_NOWAIT; 97 98 if (*Argv[0] != '/' && *Argv[0] != '\\') /* will swawnvp use PATH? */ 99 TAINT_ENV(); /* testing IFS here is overkill, probably */ 100 if (really && *(tmps = SvPV(really, na))) 101 rc = result(trueflag, spawnvp(flag,tmps,Argv)); 102 else 103 rc = result(trueflag, spawnvp(flag,Argv[0],Argv)); 104 105 if (rc < 0 && dowarn) 106 warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno)); 107 if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ 108 } else 109 rc = -1; 110 do_execfree(); 111 return rc; 112 } 113 114 int 115 do_spawn(cmd) 116 char *cmd; 117 { 118 register char **a; 119 register char *s; 120 char flags[10]; 121 char *shell, *copt; 122 int rc; 123 124 #ifdef TRYSHELL 125 if ((shell = getenv("EMXSHELL")) != NULL) 126 copt = "-c"; 127 else if ((shell = getenv("SHELL")) != NULL) 128 copt = "-c"; 129 else if ((shell = getenv("COMSPEC")) != NULL) 130 copt = "/C"; 131 else 132 shell = "cmd.exe"; 133 #else 134 /* Consensus on perl5-porters is that it is _very_ important to 135 have a shell which will not change between computers with the 136 same architecture, to avoid "action on a distance". 137 And to have simple build, this shell should be sh. */ 138 shell = "sh.exe"; 139 copt = "-c"; 140 #endif 141 142 while (*cmd && isSPACE(*cmd)) 143 cmd++; 144 145 /* save an extra exec if possible */ 146 /* see if there are shell metacharacters in it */ 147 148 if (*cmd == '.' && isSPACE(cmd[1])) 149 goto doshell; 150 151 if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4])) 152 goto doshell; 153 154 for (s = cmd; *s && isALPHA(*s); s++) ; /* catch VAR=val gizmo */ 155 if (*s == '=') 156 goto doshell; 157 158 for (s = cmd; *s; s++) { 159 if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) { 160 if (*s == '\n' && !s[1]) { 161 *s = '\0'; 162 break; 163 } 164 doshell: 165 rc = result(P_WAIT, 166 spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0)); 167 if (rc < 0 && dowarn) 168 warn("Can't spawn \"%s\": %s", shell, Strerror(errno)); 169 if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ 170 return rc; 171 } 172 } 173 174 New(402,Argv, (s - cmd) / 2 + 2, char*); 175 Cmd = savepvn(cmd, s-cmd); 176 a = Argv; 177 for (s = Cmd; *s;) { 178 while (*s && isSPACE(*s)) s++; 179 if (*s) 180 *(a++) = s; 181 while (*s && !isSPACE(*s)) s++; 182 if (*s) 183 *s++ = '\0'; 184 } 185 *a = Nullch; 186 if (Argv[0]) { 187 rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv)); 188 if (rc < 0 && dowarn) 189 warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno)); 190 if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ 191 } else 192 rc = -1; 193 do_execfree(); 194 return rc; 195 } 196 197 FILE * 198 my_popen(cmd,mode) 199 char *cmd; 200 char *mode; 201 { 202 char *shell = getenv("EMXSHELL"); 203 FILE *res; 204 205 my_setenv("EMXSHELL", "sh.exe"); 206 res = popen(cmd, mode); 207 my_setenv("EMXSHELL", shell); 208 return res; 209 } 210 211 /*****************************************************************************/ 212 213 #ifndef HAS_FORK 214 int 215 fork(void) 216 { 217 die(no_func, "Unsupported function fork"); 218 errno = EINVAL; 219 return -1; 220 } 221 #endif 222 223 /*****************************************************************************/ 224 /* not implemented in EMX 0.9a */ 225 226 void * ctermid(x) { return 0; } 227 228 #ifdef MYTTYNAME /* was not in emx0.9a */ 229 void * ttyname(x) { return 0; } 230 #endif 231 232 void * gethostent() { return 0; } 233 void * getnetent() { return 0; } 234 void * getprotoent() { return 0; } 235 void * getservent() { return 0; } 236 void sethostent(x) {} 237 void setnetent(x) {} 238 void setprotoent(x) {} 239 void setservent(x) {} 240 void endhostent(x) {} 241 void endnetent(x) {} 242 void endprotoent(x) {} 243 void endservent(x) {} 244 245 /*****************************************************************************/ 246 /* stat() hack for char/block device */ 247 248 #if OS2_STAT_HACK 249 250 /* First attempt used DosQueryFSAttach which crashed the system when 251 used with 5.001. Now just look for /dev/. */ 252 253 int 254 os2_stat(char *name, struct stat *st) 255 { 256 static int ino = SHRT_MAX; 257 258 if (stricmp(name, "/dev/con") != 0 259 && stricmp(name, "/dev/tty") != 0) 260 return stat(name, st); 261 262 memset(st, 0, sizeof *st); 263 st->st_mode = S_IFCHR|0666; 264 st->st_ino = (ino-- & 0x7FFF); 265 st->st_nlink = 1; 266 return 0; 267 } 268 269 #endif 270 271 #ifndef NO_SYS_ALLOC 272 273 static char *oldchunk; 274 static long oldsize; 275 276 #define _32_K (1<<15) 277 #define _64_K (1<<16) 278 279 /* The real problem is that DosAllocMem will grant memory on 64K-chunks 280 * boundaries only. Note that addressable space for application memory 281 * is around 240M, thus we will run out of addressable space if we 282 * allocate around 14M worth of 4K segments. 283 * Thus we allocate memory in 64K chunks, and abandon the rest of the old 284 * chunk if the new is bigger than that rest. Also, we just allocate 285 * whatever is requested if the size is bigger that 32K. With this strategy 286 * we cannot lose more than 1/2 of addressable space. */ 287 288 void * 289 sbrk(int size) 290 { 291 char *got; 292 APIRET rc; 293 int small, reqsize; 294 295 if (!size) return 0; 296 else if (size <= oldsize) { 297 got = oldchunk; 298 oldchunk += size; 299 oldsize -= size; 300 return (void *)got; 301 } else if (size >= _32_K) { 302 small = 0; 303 } else { 304 reqsize = size; 305 size = _64_K; 306 small = 1; 307 } 308 rc = DosAllocMem((void **)&got, size, PAG_COMMIT | PAG_WRITE); 309 if (rc == ERROR_NOT_ENOUGH_MEMORY) { 310 return (void *) -1; 311 } else if ( rc ) die("Got an error from DosAllocMem: %li", (long)rc); 312 if (small) { 313 /* Chunk is small, register the rest for future allocs. */ 314 oldchunk = got + reqsize; 315 oldsize = size - reqsize; 316 } 317 return (void *)got; 318 } 319 #endif /* ! defined NO_SYS_ALLOC */ 320 321 /* tmp path */ 322 323 char *tmppath = TMPPATH1; 324 325 void 326 settmppath() 327 { 328 char *p = getenv("TMP"), *tpath; 329 int len; 330 331 if (!p) p = getenv("TEMP"); 332 if (!p) return; 333 len = strlen(p); 334 tpath = (char *)malloc(len + strlen(TMPPATH1) + 2); 335 strcpy(tpath, p); 336 tpath[len] = '/'; 337 strcpy(tpath + len + 1, TMPPATH1); 338 tmppath = tpath; 339 } 340 341 #include "XSUB.h" 342 343 XS(XS_File__Copy_syscopy) 344 { 345 dXSARGS; 346 if (items < 2 || items > 3) 347 croak("Usage: File::Copy::syscopy(src,dst,flag=0)"); 348 { 349 char * src = (char *)SvPV(ST(0),na); 350 char * dst = (char *)SvPV(ST(1),na); 351 U32 flag; 352 int RETVAL, rc; 353 354 if (items < 3) 355 flag = 0; 356 else { 357 flag = (unsigned long)SvIV(ST(2)); 358 } 359 360 errno = DosCopy(src, dst, flag); 361 RETVAL = !errno; 362 ST(0) = sv_newmortal(); 363 sv_setiv(ST(0), (IV)RETVAL); 364 } 365 XSRETURN(1); 366 } 367 368 OS2_Perl_data_t OS2_Perl_data; 369 370 int 371 Xs_OS2_init() 372 { 373 char *file = __FILE__; 374 { 375 newXS("File::Copy::syscopy", XS_File__Copy_syscopy, file); 376 } 377 } 378 379 void 380 Perl_OS2_init() 381 { 382 settmppath(); 383 OS2_Perl_data.xs_init = &Xs_OS2_init; 384 } 385