cygwin/cygwin.c

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