Simplify VMS symlink override.
[perl.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,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(pathname, 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(src_path, 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(src_path, 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 }