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,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; 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; 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 } 570