djgpp/djgpp.c

   1 #include <libc/stubs.h>
   2 #include <io.h>
   3 #include <errno.h>
   4 #include <stdio.h>
   5 #include <stdlib.h>
   6 #include <string.h>
   7 #include <unistd.h>
   8 #include <libc/file.h>
   9 #include <process.h>
  10 #include <fcntl.h>
  11 #include <glob.h>
  12 #include <sys/fsext.h>
  13 #include <crt0.h>
  14 #include "EXTERN.h"
  15 #include "perl.h"
  16 #include "XSUB.h"
  17
  18 /* hold file pointer, command, mode, and the status of the command */
  19 struct pipe_list {
  20   FILE *fp;
  21   int exit_status;
  22   struct pipe_list *next;
  23   char *command, mode;
  24 };
  25
  26 /* static, global list pointer */
  27 static struct pipe_list *pl = NULL;
  28
  29 FILE *
  30 popen (const char *cm, const char *md) /* program name, pipe mode */
  31 {
  32   struct pipe_list *l1;
  33   int fd;
  34   char *temp_name=NULL;
  35
  36   /* make new node */
  37   if ((l1 = (struct pipe_list *) malloc (sizeof (*l1)))
  38      && (temp_name = malloc (L_tmpnam)) && tmpnam (temp_name))
  39   {
  40     l1->fp = NULL;
  41     l1->command = NULL;
  42     l1->next = pl;
  43     l1->exit_status = -1;
  44     l1->mode = md[0];
  45
  46     /* if caller wants to read */
  47     if (md[0] == 'r' && (fd = dup (fileno (stdout))) >= 0)
  48     {
  49       if ((l1->fp = freopen (temp_name, "wb", stdout)))
  50       {
  51         l1->exit_status = system (cm);
  52         if (dup2 (fd, fileno (stdout)) >= 0)
  53           l1->fp = fopen (temp_name, md);
  54       }
  55       close (fd);
  56     }
  57     /* if caller wants to write */
  58     else if (md[0] == 'w' && (l1->command = malloc (1 + strlen (cm))))
  59     {
  60       strcpy (l1->command, cm);
  61       l1->fp = fopen (temp_name, md);
  62     }
  63
  64     if (l1->fp)
  65     {
  66       l1->fp->_flag |= _IORMONCL; /* remove on close */
  67       l1->fp->_name_to_remove = temp_name;
  68       return (pl = l1)->fp;
  69     }
  70     free (l1->command);
  71   }
  72   free (temp_name);
  73   free (l1);
  74   return NULL;
  75 }
  76
  77 int
  78 pclose (FILE *pp)
  79 {
  80   struct pipe_list *l1, **l2;   /* list pointers */
  81   int retval=-1;                /* function return value */
  82
  83   for (l2 = &pl; *l2 && (*l2)->fp != pp; l2 = &((*l2)->next))
  84     ;
  85   if (!(l1 = *l2))
  86     return retval;
  87   *l2 = l1->next;
  88
  89   /* if pipe was opened to write */
  90   if (l1->mode == 'w')
  91   {
  92     int fd;
  93     fflush (l1->fp);
  94     close (fileno (l1->fp));
  95
  96     if ((fd = dup (fileno (stdin))) >= 0
  97        && (freopen (l1->fp->_name_to_remove, "rb", stdin)))
  98     {
  99       retval = system (l1->command);
 100       dup2 (fd, fileno (stdin));
 101     }
 102     close (fd);
 103     free (l1->command);
 104   }
 105   else
 106     /* if pipe was opened to read, return the exit status we saved */
 107     retval = l1->exit_status;
 108
 109   fclose (l1->fp);              /* this removes the temp file */
 110   free (l1);
 111   return retval;                /* retval==0 ? OK : ERROR */
 112 }
 113
 114 /**/
 115
 116 #define EXECF_SPAWN 0
 117 #define EXECF_EXEC 1
 118
 119 static int
 120 convretcode (pTHX_ int rc,char *prog,int fl)
 121 {
 122     if (rc < 0 && ckWARN(WARN_EXEC))
 123         Perl_warner(aTHX_ WARN_EXEC,"Can't %s \"%s\": %s",
 124                     fl ? "exec" : "spawn",prog,Strerror (errno));
 125     if (rc >= 0)
 126         return rc << 8;
 127     return -1;
 128 }
 129
 130 int
 131 do_aspawn (pTHX_ SV *really,SV **mark,SV **sp)
 132 {
 133     int  rc;
 134     char **a,*tmps,**argv;
 135     STRLEN n_a;
 136
 137     if (sp<=mark)
 138         return -1;
 139     a=argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
 140
 141     while (++mark <= sp)
 142         if (*mark)
 143             *a++ = SvPVx(*mark, n_a);
 144         else
 145             *a++ = "";
 146     *a = Nullch;
 147
 148     if (argv[0][0] != '/' && argv[0][0] != '\\'
 149         && !(argv[0][0] && argv[0][1] == ':'
 150         && (argv[0][2] == '/' || argv[0][2] != '\\'))
 151      ) /* will swawnvp use PATH? */
 152          TAINT_ENV();   /* testing IFS here is overkill, probably */
 153
 154     if (really && *(tmps = SvPV(really, n_a)))
 155         rc=spawnvp (P_WAIT,tmps,argv);
 156     else
 157         rc=spawnvp (P_WAIT,argv[0],argv);
 158
 159     return convretcode (rc,argv[0],EXECF_SPAWN);
 160 }
 161
 162 #define EXTRA "\x00\x00\x00\x00\x00\x00"
 163
 164 int
 165 do_spawn2 (pTHX_ char *cmd,int execf)
 166 {
 167     char **a,*s,*shell,*metachars;
 168     int  rc,unixysh;
 169
 170     if ((shell=getenv("SHELL"))==NULL && (shell=getenv("COMSPEC"))==NULL)
 171         shell="c:\\command.com" EXTRA;
 172
 173     unixysh=_is_unixy_shell (shell);
 174     metachars=unixysh ? "$&*(){}[]'\";\\?>|<~`\n" EXTRA : "*?[|<>\"\\" EXTRA;
 175
 176     while (*cmd && isSPACE(*cmd))
 177         cmd++;
 178
 179     if (strnEQ (cmd,"/bin/sh",7) && isSPACE (cmd[7]))
 180         cmd+=5;
 181
 182     /* save an extra exec if possible */
 183     /* see if there are shell metacharacters in it */
 184     if (strstr (cmd,"..."))
 185         goto doshell;
 186     if (unixysh)
 187     {
 188         if (*cmd=='.' && isSPACE (cmd[1]))
 189             goto doshell;
 190         if (strnEQ (cmd,"exec",4) && isSPACE (cmd[4]))
 191             goto doshell;
 192         for (s=cmd; *s && isALPHA (*s); s++) ;  /* catch VAR=val gizmo */
 193             if (*s=='=')
 194                 goto doshell;
 195     }
 196     for (s=cmd; *s; s++)
 197         if (strchr (metachars,*s))
 198         {
 199             if (*s=='\n' && s[1]=='\0')
 200             {
 201                 *s='\0';
 202                 break;
 203             }
 204 doshell:
 205             if (execf==EXECF_EXEC)
 206                 return convretcode (execl (shell,shell,unixysh ? "-c" : "/c",cmd,NULL),cmd,execf);
 207             return convretcode (system (cmd),cmd,execf);
 208         }
 209
 210     New (1303,PL_Argv,(s-cmd)/2+2,char*);
 211     PL_Cmd=savepvn (cmd,s-cmd);
 212     a=PL_Argv;
 213     for (s=PL_Cmd; *s;) {
 214         while (*s && isSPACE (*s)) s++;
 215         if (*s)
 216             *(a++)=s;
 217         while (*s && !isSPACE (*s)) s++;
 218         if (*s)
 219             *s++='\0';
 220     }
 221     *a=Nullch;
 222     if (!PL_Argv[0])
 223         return -1;
 224
 225     if (execf==EXECF_EXEC)
 226         rc=execvp (PL_Argv[0],PL_Argv);
 227     else
 228         rc=spawnvp (P_WAIT,PL_Argv[0],PL_Argv);
 229     return convretcode (rc,PL_Argv[0],execf);
 230 }
 231
 232 int
 233 do_spawn (pTHX_ char *cmd)
 234 {
 235     return do_spawn2 (aTHX_ cmd,EXECF_SPAWN);
 236 }
 237
 238 bool
 239 Perl_do_exec (pTHX_ char *cmd)
 240 {
 241     do_spawn2 (aTHX_ cmd,EXECF_EXEC);
 242     return FALSE;
 243 }
 244
 245 /**/
 246
 247 struct globinfo
 248 {
 249     int    fd;
 250     char   *matches;
 251     size_t size;
 252     fpos_t pos;
 253 };
 254
 255 #define MAXOPENGLOBS 10
 256
 257 static struct globinfo myglobs[MAXOPENGLOBS];
 258
 259 static struct globinfo *
 260 searchfd (int fd)
 261 {
 262     int ic;
 263     for (ic=0; ic<MAXOPENGLOBS; ic++)
 264         if (myglobs[ic].fd==fd)
 265             return myglobs+ic;
 266     return NULL;
 267 }
 268
 269 static int
 270 glob_handler (__FSEXT_Fnumber n,int *rv,va_list args)
 271 {
 272     unsigned ic;
 273     struct globinfo *gi;
 274     switch (n)
 275     {
 276         case __FSEXT_open:
 277         {
 278             char   *p1,*pattern,*name=va_arg (args,char*);
 279             STRLEN len;
 280             glob_t pglob;
 281
 282             if (strnNE (name,"/dev/dosglob/",13))
 283                 break;
 284             if ((gi=searchfd (-1)) == NULL)
 285                 break;
 286
 287             gi->pos=0;
 288             pattern=alloca (strlen (name+=13)+1);
 289             strcpy (pattern,name);
 290             if (!_USE_LFN)
 291                 strlwr (pattern);
 292             ic=pglob.gl_pathc=0;
 293             pglob.gl_pathv=NULL;
 294             while (pattern)
 295             {
 296                 if ((p1=strchr (pattern,' '))!=NULL)
 297                     *p1=0;
 298                 glob (pattern,ic,0,&pglob);
 299                 ic=GLOB_APPEND;
 300                 if ((pattern=p1)!=NULL)
 301                     pattern++;
 302             }
 303             for (ic=len=0; ic<pglob.gl_pathc; ic++)
 304                 len+=1+strlen (pglob.gl_pathv[ic]);
 305             if (len)
 306             {
 307                 if ((gi->matches=p1=(char*) malloc (gi->size=len))==NULL)
 308                     break;
 309                 for (ic=0; ic<pglob.gl_pathc; ic++)
 310                 {
 311                     strcpy (p1,pglob.gl_pathv[ic]);
 312                     p1+=strlen (p1)+1;
 313                 }
 314             }
 315             else
 316             {
 317                 if ((gi->matches=strdup (name))==NULL)
 318                     break;
 319                 gi->size=strlen (name)+1;
 320             }
 321             globfree (&pglob);
 322             gi->fd=*rv=__FSEXT_alloc_fd (glob_handler);
 323             return 1;
 324         }
 325         case __FSEXT_read:
 326         {
 327             int      fd=va_arg (args,int);
 328             char   *buf=va_arg (args,char*);
 329             size_t  siz=va_arg (args,size_t);
 330
 331             if ((gi=searchfd (fd))==NULL)
 332                 break;
 333
 334             if (siz+gi->pos > gi->size)
 335                 siz = gi->size - gi->pos;
 336             memcpy (buf,gi->pos+gi->matches,siz);
 337             gi->pos += siz;
 338             *rv=siz;
 339             return 1;
 340         }
 341         case __FSEXT_close:
 342         {
 343             int fd=va_arg (args,int);
 344
 345             if ((gi=searchfd (fd))==NULL)
 346                 break;
 347             free (gi->matches);
 348             gi->fd=-1;
 349             break;
 350         }
 351         default:
 352             break;
 353     }
 354     return 0;
 355 }
 356
 357 static
 358 XS(dos_GetCwd)
 359 {
 360     dXSARGS;
 361
 362     if (items)
 363         Perl_croak (aTHX_ "Usage: Dos::GetCwd()");
 364     {
 365         char tmp[PATH_MAX+2];
 366         ST(0)=sv_newmortal ();
 367         if (getcwd (tmp,PATH_MAX+1)!=NULL)
 368             sv_setpv ((SV*)ST(0),tmp);
 369     }
 370     XSRETURN (1);
 371 }
 372
 373 static
 374 XS(dos_UseLFN)
 375 {
 376     dXSARGS;
 377     XSRETURN_IV (_USE_LFN);
 378 }
 379
 380 void
 381 Perl_init_os_extras(pTHX)
 382 {
 383     char *file = __FILE__;
 384
 385     dXSUB_SYS;
 386
 387     newXS ("Dos::GetCwd",dos_GetCwd,file);
 388     newXS ("Dos::UseLFN",dos_UseLFN,file);
 389
 390     /* install my File System Extension for globbing */
 391     __FSEXT_add_open_handler (glob_handler);
 392     memset (myglobs,-1,sizeof (myglobs));
 393 }
 394
 395 static char *perlprefix;
 396
 397 #define PERL5 "/perl5"
 398
 399 char *djgpp_pathexp (const char *p)
 400 {
 401     static char expp[PATH_MAX];
 402     strcpy (expp,perlprefix);
 403     switch (p[0])
 404     {
 405         case 'B':
 406             strcat (expp,"/bin");
 407             break;
 408         case 'S':
 409             strcat (expp,"/lib" PERL5 "/site");
 410             break;
 411         default:
 412             strcat (expp,"/lib" PERL5);
 413             break;
 414     }
 415     return expp;
 416 }
 417
 418 void
 419 Perl_DJGPP_init (int *argcp,char ***argvp)
 420 {
 421     char *p;
 422
 423     perlprefix=strdup (**argvp);
 424     strlwr (perlprefix);
 425     if ((p=strrchr (perlprefix,'/'))!=NULL)
 426     {
 427         *p=0;
 428         if (strEQ (p-4,"/bin"))
 429             p[-4]=0;
 430     }
 431     else
 432         strcpy (perlprefix,"..");
 433 }
 434
 435 int
 436 djgpp_fflush (FILE *fp)
 437 {
 438     int res;
 439
 440     if ((res = fflush(fp)) == 0 && fp) {
 441         Stat_t s;
 442         if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode))
 443             res = fsync(fileno(fp));
 444     }
 445 /*
 446  * If the flush succeeded but set end-of-file, we need to clear
 447  * the error because our caller may check ferror().  BTW, this
 448  * probably means we just flushed an empty file.
 449  */
 450     if (res == 0 && fp && ferror(fp) == EOF) clearerr(fp);
 451
 452     return res;
 453 }