This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Removed the ifdefs for INCOMPLETE_TAINTS
[perl5.git] / 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     /* uvchr_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_uvchr_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         SvTAINTED_on(ST(0));
203         XSRETURN(1);
204     }
205     XSRETURN_UNDEF;
206 }
207
208 XS(XS_Cygwin_pid_to_winpid)
209 {
210     dXSARGS;
211     dXSTARG;
212     pid_t pid, RETVAL;
213
214     if (items != 1)
215         Perl_croak(aTHX_ "Usage: Cygwin::pid_to_winpid(pid)");
216
217     pid = (pid_t)SvIV(ST(0));
218
219     if ((RETVAL = cygwin_internal(CW_CYGWIN_PID_TO_WINPID, pid)) > 0) {
220         XSprePUSH; PUSHi((IV)RETVAL);
221         XSRETURN(1);
222     }
223     XSRETURN_UNDEF;
224 }
225
226 XS(XS_Cygwin_winpid_to_pid)
227 {
228     dXSARGS;
229     dXSTARG;
230     pid_t pid, RETVAL;
231
232     if (items != 1)
233         Perl_croak(aTHX_ "Usage: Cygwin::winpid_to_pid(pid)");
234
235     pid = (pid_t)SvIV(ST(0));
236
237 #if (CYGWIN_VERSION_API_MINOR >= 181)
238     RETVAL = cygwin_winpid_to_pid(pid);
239 #else
240     RETVAL = cygwin32_winpid_to_pid(pid);
241 #endif
242     if (RETVAL > 0) {
243         XSprePUSH; PUSHi((IV)RETVAL);
244         XSRETURN(1);
245     }
246     XSRETURN_UNDEF;
247 }
248
249 XS(XS_Cygwin_win_to_posix_path)
250
251 {
252     dXSARGS;
253     int absolute_flag = 0;
254     STRLEN len;
255     int err = 0;
256     char *src_path;
257     char *posix_path;
258     int isutf8 = 0;
259
260     if (items < 1 || items > 2)
261         Perl_croak(aTHX_ "Usage: Cygwin::win_to_posix_path(pathname, [absolute])");
262
263     src_path = SvPV(ST(0), len);
264     if (items == 2)
265         absolute_flag = SvTRUE(ST(1));
266
267     if (!len)
268         Perl_croak(aTHX_ "can't convert empty path");
269     isutf8 = SvUTF8(ST(0));
270
271 #if (CYGWIN_VERSION_API_MINOR >= 181)
272     /* Check utf8 flag and use wide api then.
273        Size calculation: On overflow let cygwin_conv_path calculate the final size.
274      */
275     if (isutf8) {
276         int what = absolute_flag ? CCP_WIN_W_TO_POSIX : CCP_WIN_W_TO_POSIX | CCP_RELATIVE;
277         int wlen = sizeof(wchar_t)*(len + 260 + 1001);
278         wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len);
279         wchar_t *wbuf = (wchar_t *) safemalloc(wlen);
280         if (!IN_BYTES) {
281             mbstate_t mbs;
282             char *oldlocale = setlocale(LC_CTYPE, NULL);
283             setlocale(LC_CTYPE, "utf-8");
284             /* utf8_to_uvchr_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
285             wlen = mbsrtowcs(wpath, (const char**)&src_path, wlen, &mbs);
286             if (wlen > 0)
287                 err = cygwin_conv_path(what, wpath, wbuf, wlen);
288             if (oldlocale) setlocale(LC_CTYPE, oldlocale);
289             else setlocale(LC_CTYPE, "C");
290         } else { /* use bytes; assume already ucs-2 encoded bytestream */
291             err = cygwin_conv_path(what, src_path, wbuf, wlen);
292         }
293         if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
294             int newlen = cygwin_conv_path(what, wpath, wbuf, 0);
295             wbuf = (wchar_t *) realloc(&wbuf, newlen);
296             err = cygwin_conv_path(what, wpath, wbuf, newlen);
297             wlen = newlen;
298         }
299         /* utf16_to_utf8(*p, *d, bytlen, *newlen) */
300         posix_path = (char *) safemalloc(wlen*3);
301         Perl_utf16_to_utf8(aTHX_ (U8*)&wpath, (U8*)posix_path, (I32)wlen*2, (I32*)&len);
302         /*
303         wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL);
304         posix_path = (char *) safemalloc(wlen+1);
305         wcsrtombs(posix_path, (const wchar_t **)&wbuf, wlen, NULL);
306         */
307     } else {
308         int what = absolute_flag ? CCP_WIN_A_TO_POSIX : CCP_WIN_A_TO_POSIX | CCP_RELATIVE;
309         posix_path = (char *) safemalloc (len + 260 + 1001);
310         err = cygwin_conv_path(what, src_path, posix_path, len + 260 + 1001);
311         if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
312             int newlen = cygwin_conv_path(what, src_path, posix_path, 0);
313             posix_path = (char *) realloc(&posix_path, newlen);
314             err = cygwin_conv_path(what, src_path, posix_path, newlen);
315         }
316     }
317 #else
318     posix_path = (char *) safemalloc (len + 260 + 1001);
319     if (absolute_flag)
320         err = cygwin_conv_to_full_posix_path(src_path, posix_path);
321     else
322         err = cygwin_conv_to_posix_path(src_path, posix_path);
323 #endif
324     if (!err) {
325         EXTEND(SP, 1);
326         ST(0) = sv_2mortal(newSVpv(posix_path, 0));
327         if (isutf8) { /* src was utf-8, so result should also */
328             /* TODO: convert ANSI (local windows encoding) to utf-8 on cygwin-1.5 */
329             SvUTF8_on(ST(0));
330         }
331         safefree(posix_path);
332         XSRETURN(1);
333     } else {
334         safefree(posix_path);
335         XSRETURN_UNDEF;
336     }
337 }
338
339 XS(XS_Cygwin_posix_to_win_path)
340 {
341     dXSARGS;
342     int absolute_flag = 0;
343     STRLEN len;
344     int err = 0;
345     char *src_path, *win_path;
346     int isutf8 = 0;
347
348     if (items < 1 || items > 2)
349         Perl_croak(aTHX_ "Usage: Cygwin::posix_to_win_path(pathname, [absolute])");
350
351     src_path = SvPVx(ST(0), len);
352     if (items == 2)
353         absolute_flag = SvTRUE(ST(1));
354
355     if (!len)
356         Perl_croak(aTHX_ "can't convert empty path");
357     isutf8 = SvUTF8(ST(0));
358 #if (CYGWIN_VERSION_API_MINOR >= 181)
359     /* Check utf8 flag and use wide api then.
360        Size calculation: On overflow let cygwin_conv_path calculate the final size.
361      */
362     if (isutf8) {
363         int what = absolute_flag ? CCP_POSIX_TO_WIN_W : CCP_POSIX_TO_WIN_W | CCP_RELATIVE;
364         int wlen = sizeof(wchar_t)*(len + 260 + 1001);
365         wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len);
366         wchar_t *wbuf = (wchar_t *) safemalloc(wlen);
367         char *oldlocale = setlocale(LC_CTYPE, NULL);
368         setlocale(LC_CTYPE, "utf-8");
369         if (!IN_BYTES) {
370             mbstate_t mbs;
371             /* utf8_to_uvchr_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
372             wlen = mbsrtowcs(wpath, (const char**)&src_path, wlen, &mbs);
373             if (wlen > 0)
374                 err = cygwin_conv_path(what, wpath, wbuf, wlen);
375         } else { /* use bytes; assume already ucs-2 encoded bytestream */
376             err = cygwin_conv_path(what, src_path, wbuf, wlen);
377         }
378         if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
379             int newlen = cygwin_conv_path(what, wpath, wbuf, 0);
380             wbuf = (wchar_t *) realloc(&wbuf, newlen);
381             err = cygwin_conv_path(what, wpath, wbuf, newlen);
382             wlen = newlen;
383         }
384         /* also see utf8.c: Perl_utf16_to_utf8() or Encoding::_bytes_to_utf8(sv, "UCS-2BE"); */
385         wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL);
386         win_path = (char *) safemalloc(wlen+1);
387         wcsrtombs(win_path, (const wchar_t **)&wbuf, wlen, NULL);
388         if (oldlocale) setlocale(LC_CTYPE, oldlocale);
389         else setlocale(LC_CTYPE, "C");
390     } else {
391         int what = absolute_flag ? CCP_POSIX_TO_WIN_A : CCP_POSIX_TO_WIN_A | CCP_RELATIVE;
392         win_path = (char *) safemalloc(len + 260 + 1001);
393         err = cygwin_conv_path(what, src_path, win_path, len + 260 + 1001);
394         if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
395             int newlen = cygwin_conv_path(what, src_path, win_path, 0);
396             win_path = (char *) realloc(&win_path, newlen);
397             err = cygwin_conv_path(what, src_path, win_path, newlen);
398         }
399     }
400 #else
401     if (isutf8)
402         Perl_warn(aTHX_ "can't convert utf8 path");
403     win_path = (char *) safemalloc(len + 260 + 1001);
404     if (absolute_flag)
405         err = cygwin_conv_to_full_win32_path(src_path, win_path);
406     else
407         err = cygwin_conv_to_win32_path(src_path, win_path);
408 #endif
409     if (!err) {
410         EXTEND(SP, 1);
411         ST(0) = sv_2mortal(newSVpv(win_path, 0));
412         if (isutf8) {
413             SvUTF8_on(ST(0));
414         }
415         safefree(win_path);
416         XSRETURN(1);
417     } else {
418         safefree(win_path);
419         XSRETURN_UNDEF;
420     }
421 }
422
423 XS(XS_Cygwin_mount_table)
424 {
425     dXSARGS;
426     struct mntent *mnt;
427
428     if (items != 0)
429         Perl_croak(aTHX_ "Usage: Cygwin::mount_table");
430     /* => array of [mnt_dir mnt_fsname mnt_type mnt_opts] */
431
432     setmntent (0, 0);
433     while ((mnt = getmntent (0))) {
434         AV* av = newAV();
435         av_push(av, newSVpvn(mnt->mnt_dir, strlen(mnt->mnt_dir)));
436         av_push(av, newSVpvn(mnt->mnt_fsname, strlen(mnt->mnt_fsname)));
437         av_push(av, newSVpvn(mnt->mnt_type, strlen(mnt->mnt_type)));
438         av_push(av, newSVpvn(mnt->mnt_opts, strlen(mnt->mnt_opts)));
439         XPUSHs(sv_2mortal(newRV_noinc((SV*)av)));
440     }
441     endmntent (0);
442     PUTBACK;
443 }
444
445 XS(XS_Cygwin_mount_flags)
446 {
447     dXSARGS;
448     char *pathname;
449     char flags[PATH_MAX];
450     flags[0] = '\0';
451
452     if (items != 1)
453         Perl_croak(aTHX_ "Usage: Cygwin::mount_flags( mnt_dir | '/cygdrive' )");
454
455     pathname = SvPV_nolen(ST(0));
456
457     if (!strcmp(pathname, "/cygdrive")) {
458         char user[PATH_MAX];
459         char system[PATH_MAX];
460         char user_flags[PATH_MAX];
461         char system_flags[PATH_MAX];
462
463         cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system,
464                          user_flags, system_flags);
465
466         if (strlen(user) > 0) {
467             sprintf(flags, "%s,cygdrive,%s", user_flags, user);
468         } else {
469             sprintf(flags, "%s,cygdrive,%s", system_flags, system);
470         }
471
472         ST(0) = sv_2mortal(newSVpv(flags, 0));
473         XSRETURN(1);
474
475     } else {
476         struct mntent *mnt;
477         int found = 0;
478         setmntent (0, 0);
479         while ((mnt = getmntent (0))) {
480             if (!strcmp(pathname, mnt->mnt_dir)) {
481                 strcpy(flags, mnt->mnt_type);
482                 if (strlen(mnt->mnt_opts) > 0) {
483                     strcat(flags, ",");
484                     strcat(flags, mnt->mnt_opts);
485                 }
486                 found++;
487                 break;
488             }
489         }
490         endmntent (0);
491
492         /* Check if arg is the current volume moint point if not default,
493          * and then use CW_GET_CYGDRIVE_INFO also.
494          */
495         if (!found) {
496             char user[PATH_MAX];
497             char system[PATH_MAX];
498             char user_flags[PATH_MAX];
499             char system_flags[PATH_MAX];
500
501             cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system,
502                              user_flags, system_flags);
503
504             if (strlen(user) > 0) {
505                 if (strcmp(user,pathname)) {
506                     sprintf(flags, "%s,cygdrive,%s", user_flags, user);
507                     found++;
508                 }
509             } else {
510                 if (strcmp(user,pathname)) {
511                     sprintf(flags, "%s,cygdrive,%s", system_flags, system);
512                     found++;
513                 }
514             }
515         }
516         if (found) {
517             ST(0) = sv_2mortal(newSVpv(flags, 0));
518             XSRETURN(1);
519         } else {
520             XSRETURN_UNDEF;
521         }
522     }
523 }
524
525 XS(XS_Cygwin_is_binmount)
526 {
527     dXSARGS;
528     char *pathname;
529
530     if (items != 1)
531         Perl_croak(aTHX_ "Usage: Cygwin::is_binmount(pathname)");
532
533     pathname = SvPV_nolen(ST(0));
534
535     ST(0) = boolSV(cygwin_internal(CW_GET_BINMODE, pathname));
536     XSRETURN(1);
537 }
538
539 XS(XS_Cygwin_sync_winenv){ cygwin_internal(CW_SYNC_WINENV); }
540
541 void
542 init_os_extras(void)
543 {
544     dTHX;
545     char const *file = __FILE__;
546     void *handle;
547
548     newXS("Cwd::cwd", Cygwin_cwd, file);
549     newXSproto("Cygwin::winpid_to_pid", XS_Cygwin_winpid_to_pid, file, "$");
550     newXSproto("Cygwin::pid_to_winpid", XS_Cygwin_pid_to_winpid, file, "$");
551     newXSproto("Cygwin::win_to_posix_path", XS_Cygwin_win_to_posix_path, file, "$;$");
552     newXSproto("Cygwin::posix_to_win_path", XS_Cygwin_posix_to_win_path, file, "$;$");
553     newXSproto("Cygwin::mount_table", XS_Cygwin_mount_table, file, "");
554     newXSproto("Cygwin::mount_flags", XS_Cygwin_mount_flags, file, "$");
555     newXSproto("Cygwin::is_binmount", XS_Cygwin_is_binmount, file, "$");
556     newXS("Cygwin::sync_winenv", XS_Cygwin_sync_winenv, file);
557
558     /* Initialize Win32CORE if it has been statically linked. */
559     handle = dlopen(NULL, RTLD_LAZY);
560     if (handle) {
561         void (*pfn_init)(pTHX);
562         pfn_init = (void (*)(pTHX))dlsym(handle, "init_Win32CORE");
563         if (pfn_init)
564             pfn_init(aTHX);
565         dlclose(handle);
566     }
567 }