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