os2/os2.c

   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 }