cygwin/cygwin.c

   1 /*
   2  * Cygwin extras
   3  */
   4
   5 #include "EXTERN.h"
   6 #include "perl.h"
   7 #undef USE_DYNAMIC_LOADING
   8 #include "XSUB.h"
   9
  10 #include <unistd.h>
  11 #include <process.h>
  12 #include <sys/cygwin.h>
  13 #include <cygwin/version.h>
  14 #include <mntent.h>
  15 #include <alloca.h>
  16 #include <dlfcn.h>
  17 #if (CYGWIN_VERSION_API_MINOR >= 181)
  18 #include <wchar.h>
  19 #endif
  20
  21 /*
  22  * pp_system() implemented via spawn()
  23  * - more efficient and useful when embedding Perl in non-Cygwin apps
  24  * - code mostly borrowed from djgpp.c
  25  */
  26 static int
  27 do_spawnvp (const char *path, const char * const *argv)
  28 {
  29     dTHX;
  30     Sigsave_t ihand,qhand;
  31     int childpid, result, status;
  32
  33     rsignal_save(SIGINT, (Sighandler_t) SIG_IGN, &ihand);
  34     rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
  35     childpid = spawnvp(_P_NOWAIT,path,argv);
  36     if (childpid < 0) {
  37         status = -1;
  38         if(ckWARN(WARN_EXEC))
  39             Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn \"%s\": %s",
  40                     path,Strerror (errno));
  41     } else {
  42         do {
  43             result = wait4pid(childpid, &status, 0);
  44         } while (result == -1 && errno == EINTR);
  45         if(result < 0)
  46             status = -1;
  47     }
  48     (void)rsignal_restore(SIGINT, &ihand);
  49     (void)rsignal_restore(SIGQUIT, &qhand);
  50     return status;
  51 }
  52
  53 int
  54 do_aspawn (SV *really, void **mark, void **sp)
  55 {
  56     dTHX;
  57     int  rc;
  58     char const **a;
  59     char *tmps,**argv;
  60     STRLEN n_a;
  61
  62     if (sp<=mark)
  63         return -1;
  64     argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
  65     a=(char const **)argv;
  66
  67     while (++mark <= sp)
  68         if (*mark)
  69             *a++ = SvPVx((SV *)*mark, n_a);
  70         else
  71             *a++ = "";
  72     *a = (char*)NULL;
  73
  74     if (argv[0][0] != '/' && argv[0][0] != '\\'
  75         && !(argv[0][0] && argv[0][1] == ':'
  76         && (argv[0][2] == '/' || argv[0][2] != '\\'))
  77      ) /* will swawnvp use PATH? */
  78          TAINT_ENV();   /* testing IFS here is overkill, probably */
  79
  80     if (really && *(tmps = SvPV(really, n_a)))
  81         rc=do_spawnvp (tmps,(const char * const *)argv);
  82     else
  83         rc=do_spawnvp (argv[0],(const char *const *)argv);
  84
  85     return rc;
  86 }
  87
  88 int
  89 do_spawn (char *cmd)
  90 {
  91     dTHX;
  92     char const **a;
  93     char *s;
  94     char const *metachars = "$&*(){}[]'\";\\?>|<~`\n";
  95     const char *command[4];
  96
  97     while (*cmd && isSPACE(*cmd))
  98         cmd++;
  99
 100     if (strnEQ (cmd,"/bin/sh",7) && isSPACE (cmd[7]))
 101         cmd+=5;
 102
 103     /* save an extra exec if possible */
 104     /* see if there are shell metacharacters in it */
 105     if (strstr (cmd,"..."))
 106         goto doshell;
 107     if (*cmd=='.' && isSPACE (cmd[1]))
 108         goto doshell;
 109     if (strnEQ (cmd,"exec",4) && isSPACE (cmd[4]))
 110         goto doshell;
 111     for (s=cmd; *s && isALPHA (*s); s++) ;      /* catch VAR=val gizmo */
 112         if (*s=='=')
 113             goto doshell;
 114
 115     for (s=cmd; *s; s++)
 116         if (strchr (metachars,*s))
 117         {
 118             if (*s=='\n' && s[1]=='\0')
 119             {
 120                 *s='\0';
 121                 break;
 122             }
 123         doshell:
 124             command[0] = "sh";
 125             command[1] = "-c";
 126             command[2] = cmd;
 127             command[3] = NULL;
 128
 129             return do_spawnvp("sh",command);
 130         }
 131
 132     Newx (PL_Argv, (s-cmd)/2+2, const char*);
 133     PL_Cmd=savepvn (cmd,s-cmd);
 134     a=PL_Argv;
 135     for (s=PL_Cmd; *s;) {
 136         while (*s && isSPACE (*s)) s++;
 137         if (*s)
 138             *(a++)=s;
 139         while (*s && !isSPACE (*s)) s++;
 140         if (*s)
 141             *s++='\0';
 142     }
 143     *a = (char*)NULL;
 144     if (!PL_Argv[0])
 145         return -1;
 146
 147     return do_spawnvp(PL_Argv[0],(const char * const *)PL_Argv);
 148 }
 149
 150 #if (CYGWIN_VERSION_API_MINOR >= 181)
 151 char*
 152 wide_to_utf8(const wchar_t *wbuf)
 153 {
 154     char *buf;
 155     int wlen = 0;
 156     char *oldlocale = setlocale(LC_CTYPE, NULL);
 157     setlocale(LC_CTYPE, "utf-8");
 158
 159     /* uvuni_to_utf8(buf, chr) or Encoding::_bytes_to_utf8(sv, "UCS-2BE"); */
 160     wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL);
 161     buf = (char *) safemalloc(wlen+1);
 162     wcsrtombs(buf, (const wchar_t **)&wbuf, wlen, NULL);
 163
 164     if (oldlocale) setlocale(LC_CTYPE, oldlocale);
 165     else setlocale(LC_CTYPE, "C");
 166     return buf;
 167 }
 168
 169 wchar_t*
 170 utf8_to_wide(const char *buf)
 171 {
 172     wchar_t *wbuf;
 173     mbstate_t mbs;
 174     char *oldlocale = setlocale(LC_CTYPE, NULL);
 175     int wlen = sizeof(wchar_t)*strlen(buf);
 176
 177     setlocale(LC_CTYPE, "utf-8");
 178     wbuf = (wchar_t *) safemalloc(wlen);
 179     /* utf8_to_uvuni_buf(pathname, pathname + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
 180     wlen = mbsrtowcs(wbuf, (const char**)&buf, wlen, &mbs);
 181
 182     if (oldlocale) setlocale(LC_CTYPE, oldlocale);
 183     else setlocale(LC_CTYPE, "C");
 184     return wbuf;
 185 }
 186 #endif /* cygwin 1.7 */
 187
 188 /* see also Cwd.pm */
 189 XS(Cygwin_cwd)
 190 {
 191     dXSARGS;
 192     char *cwd;
 193
 194     /* See http://rt.perl.org/rt3/Ticket/Display.html?id=38628
 195        There is Cwd->cwd() usage in the wild, and previous versions didn't die.
 196      */
 197     if(items > 1)
 198         Perl_croak(aTHX_ "Usage: Cwd::cwd()");
 199     if((cwd = getcwd(NULL, -1))) {
 200         ST(0) = sv_2mortal(newSVpv(cwd, 0));
 201         free(cwd);
 202 #ifndef INCOMPLETE_TAINTS
 203         SvTAINTED_on(ST(0));
 204 #endif
 205         XSRETURN(1);
 206     }
 207     XSRETURN_UNDEF;
 208 }
 209
 210 XS(XS_Cygwin_pid_to_winpid)
 211 {
 212     dXSARGS;
 213     dXSTARG;
 214     pid_t pid, RETVAL;
 215
 216     if (items != 1)
 217         Perl_croak(aTHX_ "Usage: Cygwin::pid_to_winpid(pid)");
 218
 219     pid = (pid_t)SvIV(ST(0));
 220
 221     if ((RETVAL = cygwin_internal(CW_CYGWIN_PID_TO_WINPID, pid)) > 0) {
 222         XSprePUSH; PUSHi((IV)RETVAL);
 223         XSRETURN(1);
 224     }
 225     XSRETURN_UNDEF;
 226 }
 227
 228 XS(XS_Cygwin_winpid_to_pid)
 229 {
 230     dXSARGS;
 231     dXSTARG;
 232     pid_t pid, RETVAL;
 233
 234     if (items != 1)
 235         Perl_croak(aTHX_ "Usage: Cygwin::winpid_to_pid(pid)");
 236
 237     pid = (pid_t)SvIV(ST(0));
 238
 239 #if (CYGWIN_VERSION_API_MINOR >= 181)
 240     RETVAL = cygwin_winpid_to_pid(pid);
 241 #else
 242     RETVAL = cygwin32_winpid_to_pid(pid);
 243 #endif
 244     if (RETVAL > 0) {
 245         XSprePUSH; PUSHi((IV)RETVAL);
 246         XSRETURN(1);
 247     }
 248     XSRETURN_UNDEF;
 249 }
 250
 251 XS(XS_Cygwin_win_to_posix_path)
 252
 253 {
 254     dXSARGS;
 255     int absolute_flag = 0;
 256     STRLEN len;
 257     int err = 0;
 258     char *src_path;
 259     char *posix_path;
 260     int isutf8 = 0;
 261
 262     if (items < 1 || items > 2)
 263         Perl_croak(aTHX_ "Usage: Cygwin::win_to_posix_path(pathname, [absolute])");
 264
 265     src_path = SvPV(ST(0), len);
 266     if (items == 2)
 267         absolute_flag = SvTRUE(ST(1));
 268
 269     if (!len)
 270         Perl_croak(aTHX_ "can't convert empty path");
 271     isutf8 = SvUTF8(ST(0));
 272
 273 #if (CYGWIN_VERSION_API_MINOR >= 181)
 274     /* Check utf8 flag and use wide api then.
 275        Size calculation: On overflow let cygwin_conv_path calculate the final size.
 276      */
 277     if (isutf8) {
 278         int what = absolute_flag ? CCP_WIN_W_TO_POSIX : CCP_WIN_W_TO_POSIX | CCP_RELATIVE;
 279         int wlen = sizeof(wchar_t)*(len + 260 + 1001);
 280         wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len);
 281         wchar_t *wbuf = (wchar_t *) safemalloc(wlen);
 282         if (!IN_BYTES) {
 283             mbstate_t mbs;
 284             char *oldlocale = setlocale(LC_CTYPE, NULL);
 285             setlocale(LC_CTYPE, "utf-8");
 286             /* utf8_to_uvuni_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
 287             wlen = mbsrtowcs(wpath, (const char**)&src_path, wlen, &mbs);
 288             if (wlen > 0)
 289                 err = cygwin_conv_path(what, wpath, wbuf, wlen);
 290             if (oldlocale) setlocale(LC_CTYPE, oldlocale);
 291             else setlocale(LC_CTYPE, "C");
 292         } else { /* use bytes; assume already ucs-2 encoded bytestream */
 293             err = cygwin_conv_path(what, src_path, wbuf, wlen);
 294         }
 295         if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
 296             int newlen = cygwin_conv_path(what, wpath, wbuf, 0);
 297             wbuf = (wchar_t *) realloc(&wbuf, newlen);
 298             err = cygwin_conv_path(what, wpath, wbuf, newlen);
 299             wlen = newlen;
 300         }
 301         /* utf16_to_utf8(*p, *d, bytlen, *newlen) */
 302         posix_path = (char *) safemalloc(wlen*3);
 303         Perl_utf16_to_utf8(aTHX_ (U8*)&wpath, (U8*)posix_path, (I32)wlen*2, (I32*)&len);
 304         /*
 305         wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL);
 306         posix_path = (char *) safemalloc(wlen+1);
 307         wcsrtombs(posix_path, (const wchar_t **)&wbuf, wlen, NULL);
 308         */
 309     } else {
 310         int what = absolute_flag ? CCP_WIN_A_TO_POSIX : CCP_WIN_A_TO_POSIX | CCP_RELATIVE;
 311         posix_path = (char *) safemalloc (len + 260 + 1001);
 312         err = cygwin_conv_path(what, src_path, posix_path, len + 260 + 1001);
 313         if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
 314             int newlen = cygwin_conv_path(what, src_path, posix_path, 0);
 315             posix_path = (char *) realloc(&posix_path, newlen);
 316             err = cygwin_conv_path(what, src_path, posix_path, newlen);
 317         }
 318     }
 319 #else
 320     posix_path = (char *) safemalloc (len + 260 + 1001);
 321     if (absolute_flag)
 322         err = cygwin_conv_to_full_posix_path(src_path, posix_path);
 323     else
 324         err = cygwin_conv_to_posix_path(src_path, posix_path);
 325 #endif
 326     if (!err) {
 327         EXTEND(SP, 1);
 328         ST(0) = sv_2mortal(newSVpv(posix_path, 0));
 329         if (isutf8) { /* src was utf-8, so result should also */
 330             /* TODO: convert ANSI (local windows encoding) to utf-8 on cygwin-1.5 */
 331             SvUTF8_on(ST(0));
 332         }
 333         safefree(posix_path);
 334         XSRETURN(1);
 335     } else {
 336         safefree(posix_path);
 337         XSRETURN_UNDEF;
 338     }
 339 }
 340
 341 XS(XS_Cygwin_posix_to_win_path)
 342 {
 343     dXSARGS;
 344     int absolute_flag = 0;
 345     STRLEN len;
 346     int err = 0;
 347     char *src_path, *win_path;
 348     int isutf8 = 0;
 349
 350     if (items < 1 || items > 2)
 351         Perl_croak(aTHX_ "Usage: Cygwin::posix_to_win_path(pathname, [absolute])");
 352
 353     src_path = SvPVx(ST(0), len);
 354     if (items == 2)
 355         absolute_flag = SvTRUE(ST(1));
 356
 357     if (!len)
 358         Perl_croak(aTHX_ "can't convert empty path");
 359     isutf8 = SvUTF8(ST(0));
 360 #if (CYGWIN_VERSION_API_MINOR >= 181)
 361     /* Check utf8 flag and use wide api then.
 362        Size calculation: On overflow let cygwin_conv_path calculate the final size.
 363      */
 364     if (isutf8) {
 365         int what = absolute_flag ? CCP_POSIX_TO_WIN_W : CCP_POSIX_TO_WIN_W | CCP_RELATIVE;
 366         int wlen = sizeof(wchar_t)*(len + 260 + 1001);
 367         wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len);
 368         wchar_t *wbuf = (wchar_t *) safemalloc(wlen);
 369         char *oldlocale = setlocale(LC_CTYPE, NULL);
 370         setlocale(LC_CTYPE, "utf-8");
 371         if (!IN_BYTES) {
 372             mbstate_t mbs;
 373             /* utf8_to_uvuni_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
 374             wlen = mbsrtowcs(wpath, (const char**)&src_path, wlen, &mbs);
 375             if (wlen > 0)
 376                 err = cygwin_conv_path(what, wpath, wbuf, wlen);
 377         } else { /* use bytes; assume already ucs-2 encoded bytestream */
 378             err = cygwin_conv_path(what, src_path, wbuf, wlen);
 379         }
 380         if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
 381             int newlen = cygwin_conv_path(what, wpath, wbuf, 0);
 382             wbuf = (wchar_t *) realloc(&wbuf, newlen);
 383             err = cygwin_conv_path(what, wpath, wbuf, newlen);
 384             wlen = newlen;
 385         }
 386         /* also see utf8.c: Perl_utf16_to_utf8() or Encoding::_bytes_to_utf8(sv, "UCS-2BE"); */
 387         wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL);
 388         win_path = (char *) safemalloc(wlen+1);
 389         wcsrtombs(win_path, (const wchar_t **)&wbuf, wlen, NULL);
 390         if (oldlocale) setlocale(LC_CTYPE, oldlocale);
 391         else setlocale(LC_CTYPE, "C");
 392     } else {
 393         int what = absolute_flag ? CCP_POSIX_TO_WIN_A : CCP_POSIX_TO_WIN_A | CCP_RELATIVE;
 394         win_path = (char *) safemalloc(len + 260 + 1001);
 395         err = cygwin_conv_path(what, src_path, win_path, len + 260 + 1001);
 396         if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
 397             int newlen = cygwin_conv_path(what, src_path, win_path, 0);
 398             win_path = (char *) realloc(&win_path, newlen);
 399             err = cygwin_conv_path(what, src_path, win_path, newlen);
 400         }
 401     }
 402 #else
 403     if (isutf8)
 404         Perl_warn(aTHX_ "can't convert utf8 path");
 405     win_path = (char *) safemalloc(len + 260 + 1001);
 406     if (absolute_flag)
 407         err = cygwin_conv_to_full_win32_path(src_path, win_path);
 408     else
 409         err = cygwin_conv_to_win32_path(src_path, win_path);
 410 #endif
 411     if (!err) {
 412         EXTEND(SP, 1);
 413         ST(0) = sv_2mortal(newSVpv(win_path, 0));
 414         if (isutf8) {
 415             SvUTF8_on(ST(0));
 416         }
 417         safefree(win_path);
 418         XSRETURN(1);
 419     } else {
 420         safefree(win_path);
 421         XSRETURN_UNDEF;
 422     }
 423 }
 424
 425 XS(XS_Cygwin_mount_table)
 426 {
 427     dXSARGS;
 428     struct mntent *mnt;
 429
 430     if (items != 0)
 431         Perl_croak(aTHX_ "Usage: Cygwin::mount_table");
 432     /* => array of [mnt_dir mnt_fsname mnt_type mnt_opts] */
 433
 434     setmntent (0, 0);
 435     while ((mnt = getmntent (0))) {
 436         AV* av = newAV();
 437         av_push(av, newSVpvn(mnt->mnt_dir, strlen(mnt->mnt_dir)));
 438         av_push(av, newSVpvn(mnt->mnt_fsname, strlen(mnt->mnt_fsname)));
 439         av_push(av, newSVpvn(mnt->mnt_type, strlen(mnt->mnt_type)));
 440         av_push(av, newSVpvn(mnt->mnt_opts, strlen(mnt->mnt_opts)));
 441         XPUSHs(sv_2mortal(newRV_noinc((SV*)av)));
 442     }
 443     endmntent (0);
 444     PUTBACK;
 445 }
 446
 447 XS(XS_Cygwin_mount_flags)
 448 {
 449     dXSARGS;
 450     char *pathname;
 451     char flags[PATH_MAX];
 452     flags[0] = '\0';
 453
 454     if (items != 1)
 455         Perl_croak(aTHX_ "Usage: Cygwin::mount_flags( mnt_dir | '/cygdrive' )");
 456
 457     pathname = SvPV_nolen(ST(0));
 458
 459     if (!strcmp(pathname, "/cygdrive")) {
 460         char user[PATH_MAX];
 461         char system[PATH_MAX];
 462         char user_flags[PATH_MAX];
 463         char system_flags[PATH_MAX];
 464
 465         cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system,
 466                          user_flags, system_flags);
 467
 468         if (strlen(user) > 0) {
 469             sprintf(flags, "%s,cygdrive,%s", user_flags, user);
 470         } else {
 471             sprintf(flags, "%s,cygdrive,%s", system_flags, system);
 472         }
 473
 474         ST(0) = sv_2mortal(newSVpv(flags, 0));
 475         XSRETURN(1);
 476
 477     } else {
 478         struct mntent *mnt;
 479         int found = 0;
 480         setmntent (0, 0);
 481         while ((mnt = getmntent (0))) {
 482             if (!strcmp(pathname, mnt->mnt_dir)) {
 483                 strcpy(flags, mnt->mnt_type);
 484                 if (strlen(mnt->mnt_opts) > 0) {
 485                     strcat(flags, ",");
 486                     strcat(flags, mnt->mnt_opts);
 487                 }
 488                 found++;
 489                 break;
 490             }
 491         }
 492         endmntent (0);
 493
 494         /* Check if arg is the current volume moint point if not default,
 495          * and then use CW_GET_CYGDRIVE_INFO also.
 496          */
 497         if (!found) {
 498             char user[PATH_MAX];
 499             char system[PATH_MAX];
 500             char user_flags[PATH_MAX];
 501             char system_flags[PATH_MAX];
 502
 503             cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system,
 504                              user_flags, system_flags);
 505
 506             if (strlen(user) > 0) {
 507                 if (strcmp(user,pathname)) {
 508                     sprintf(flags, "%s,cygdrive,%s", user_flags, user);
 509                     found++;
 510                 }
 511             } else {
 512                 if (strcmp(user,pathname)) {
 513                     sprintf(flags, "%s,cygdrive,%s", system_flags, system);
 514                     found++;
 515                 }
 516             }
 517         }
 518         if (found) {
 519             ST(0) = sv_2mortal(newSVpv(flags, 0));
 520             XSRETURN(1);
 521         } else {
 522             XSRETURN_UNDEF;
 523         }
 524     }
 525 }
 526
 527 XS(XS_Cygwin_is_binmount)
 528 {
 529     dXSARGS;
 530     char *pathname;
 531
 532     if (items != 1)
 533         Perl_croak(aTHX_ "Usage: Cygwin::is_binmount(pathname)");
 534
 535     pathname = SvPV_nolen(ST(0));
 536
 537     ST(0) = boolSV(cygwin_internal(CW_GET_BINMODE, pathname));
 538     XSRETURN(1);
 539 }
 540
 541 XS(XS_Cygwin_sync_winenv){ cygwin_internal(CW_SYNC_WINENV); }
 542
 543 void
 544 init_os_extras(void)
 545 {
 546     dTHX;
 547     char const *file = __FILE__;
 548     void *handle;
 549
 550     newXS("Cwd::cwd", Cygwin_cwd, file);
 551     newXSproto("Cygwin::winpid_to_pid", XS_Cygwin_winpid_to_pid, file, "$");
 552     newXSproto("Cygwin::pid_to_winpid", XS_Cygwin_pid_to_winpid, file, "$");
 553     newXSproto("Cygwin::win_to_posix_path", XS_Cygwin_win_to_posix_path, file, "$;$");
 554     newXSproto("Cygwin::posix_to_win_path", XS_Cygwin_posix_to_win_path, file, "$;$");
 555     newXSproto("Cygwin::mount_table", XS_Cygwin_mount_table, file, "");
 556     newXSproto("Cygwin::mount_flags", XS_Cygwin_mount_flags, file, "$");
 557     newXSproto("Cygwin::is_binmount", XS_Cygwin_is_binmount, file, "$");
 558     newXS("Cygwin::sync_winenv", XS_Cygwin_sync_winenv, file);
 559
 560     /* Initialize Win32CORE if it has been statically linked. */
 561     handle = dlopen(NULL, RTLD_LAZY);
 562     if (handle) {
 563         void (*pfn_init)(pTHX);
 564         pfn_init = (void (*)(pTHX))dlsym(handle, "init_Win32CORE");
 565         if (pfn_init)
 566             pfn_init(aTHX);
 567         dlclose(handle);
 568     }
 569 }