djgpp/djgpp.c

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