This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Get Cwd->cwd() to work under Cygwin
[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 <mntent.h>
14 #include <alloca.h>
15 #include <dlfcn.h>
16
17 /*
18  * pp_system() implemented via spawn()
19  * - more efficient and useful when embedding Perl in non-Cygwin apps
20  * - code mostly borrowed from djgpp.c
21  */
22 static int
23 do_spawnvp (const char *path, const char * const *argv)
24 {
25     dTHX;
26     Sigsave_t ihand,qhand;
27     int childpid, result, status;
28
29     rsignal_save(SIGINT, (Sighandler_t) SIG_IGN, &ihand);
30     rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
31     childpid = spawnvp(_P_NOWAIT,path,argv);
32     if (childpid < 0) {
33         status = -1;
34         if(ckWARN(WARN_EXEC))
35             Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn \"%s\": %s",
36                     path,Strerror (errno));
37     } else {
38         do {
39             result = wait4pid(childpid, &status, 0);
40         } while (result == -1 && errno == EINTR);
41         if(result < 0)
42             status = -1;
43     }
44     (void)rsignal_restore(SIGINT, &ihand);
45     (void)rsignal_restore(SIGQUIT, &qhand);
46     return status;
47 }
48
49 int
50 do_aspawn (SV *really, void **mark, void **sp)
51 {
52     dTHX;
53     int  rc;
54     char **a,*tmps,**argv; 
55     STRLEN n_a; 
56
57     if (sp<=mark)
58         return -1;
59     a=argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
60
61     while (++mark <= sp)
62         if (*mark)
63             *a++ = SvPVx((SV *)*mark, n_a);
64         else
65             *a++ = "";
66     *a = Nullch;
67
68     if (argv[0][0] != '/' && argv[0][0] != '\\'
69         && !(argv[0][0] && argv[0][1] == ':'
70         && (argv[0][2] == '/' || argv[0][2] != '\\'))
71      ) /* will swawnvp use PATH? */
72          TAINT_ENV();   /* testing IFS here is overkill, probably */
73
74     if (really && *(tmps = SvPV(really, n_a)))
75         rc=do_spawnvp (tmps,(const char * const *)argv);
76     else
77         rc=do_spawnvp (argv[0],(const char *const *)argv);
78
79     return rc;
80 }
81
82 int
83 do_spawn (char *cmd)
84 {
85     dTHX;
86     char **a,*s,*metachars = "$&*(){}[]'\";\\?>|<~`\n";
87     const char *command[4];
88
89     while (*cmd && isSPACE(*cmd))
90         cmd++;
91
92     if (strnEQ (cmd,"/bin/sh",7) && isSPACE (cmd[7]))
93         cmd+=5;
94
95     /* save an extra exec if possible */
96     /* see if there are shell metacharacters in it */
97     if (strstr (cmd,"..."))
98         goto doshell;
99     if (*cmd=='.' && isSPACE (cmd[1]))
100         goto doshell;
101     if (strnEQ (cmd,"exec",4) && isSPACE (cmd[4]))
102         goto doshell;
103     for (s=cmd; *s && isALPHA (*s); s++) ;      /* catch VAR=val gizmo */
104         if (*s=='=')
105             goto doshell;
106
107     for (s=cmd; *s; s++)
108         if (strchr (metachars,*s))
109         {
110             if (*s=='\n' && s[1]=='\0')
111             {
112                 *s='\0';
113                 break;
114             }
115         doshell:
116             command[0] = "sh";
117             command[1] = "-c";
118             command[2] = cmd;
119             command[3] = NULL;
120
121             return do_spawnvp("sh",command);
122         }
123
124     Newx (PL_Argv,(s-cmd)/2+2,char*);
125     PL_Cmd=savepvn (cmd,s-cmd);
126     a=PL_Argv;
127     for (s=PL_Cmd; *s;) {
128         while (*s && isSPACE (*s)) s++;
129         if (*s)
130             *(a++)=s;
131         while (*s && !isSPACE (*s)) s++;
132         if (*s)
133             *s++='\0';
134     }
135     *a=Nullch;
136     if (!PL_Argv[0])
137         return -1;
138
139     return do_spawnvp(PL_Argv[0],(const char * const *)PL_Argv);
140 }
141
142 /* see also Cwd.pm */
143 XS(Cygwin_cwd)
144 {
145     dXSARGS;
146     char *cwd;
147
148     /* See http://rt.perl.org/rt3/Ticket/Display.html?id=38628 
149        There is Cwd->cwd() usage in the wild, and previous versions didn't die.
150      */
151     if(items > 1)
152         Perl_croak(aTHX_ "Usage: Cwd::cwd()");
153     if((cwd = getcwd(NULL, -1))) {
154         ST(0) = sv_2mortal(newSVpv(cwd, 0));
155         free(cwd);
156 #ifndef INCOMPLETE_TAINTS
157         SvTAINTED_on(ST(0));
158 #endif
159         XSRETURN(1);
160     }
161     XSRETURN_UNDEF;
162 }
163
164 XS(XS_Cygwin_pid_to_winpid)
165 {
166     dXSARGS;
167     dXSTARG;
168     pid_t pid, RETVAL;
169
170     if (items != 1)
171         Perl_croak(aTHX_ "Usage: Cygwin::pid_to_winpid(pid)");
172
173     pid = (pid_t)SvIV(ST(0));
174
175     if ((RETVAL = cygwin_internal(CW_CYGWIN_PID_TO_WINPID, pid)) > 0) {
176         XSprePUSH; PUSHi((IV)RETVAL);
177         XSRETURN(1);
178     }
179     XSRETURN_UNDEF;
180 }
181
182 XS(XS_Cygwin_winpid_to_pid)
183 {
184     dXSARGS;
185     dXSTARG;
186     pid_t pid, RETVAL;
187
188     if (items != 1)
189         Perl_croak(aTHX_ "Usage: Cygwin::winpid_to_pid(pid)");
190
191     pid = (pid_t)SvIV(ST(0));
192
193     if ((RETVAL = cygwin32_winpid_to_pid(pid)) > 0) {
194         XSprePUSH; PUSHi((IV)RETVAL);
195         XSRETURN(1);
196     }
197     XSRETURN_UNDEF;
198 }
199
200 XS(XS_Cygwin_win_to_posix_path)
201 {
202     dXSARGS;
203     int absolute_flag = 0;
204     STRLEN len;
205     int err;
206     char *pathname, *buf;
207
208     if (items < 1 || items > 2)
209         Perl_croak(aTHX_ "Usage: Cygwin::win_to_posix_path(pathname, [absolute])");
210
211     pathname = SvPV(ST(0), len);
212     if (items == 2)
213         absolute_flag = SvTRUE(ST(1));
214
215     if (!len)
216         Perl_croak(aTHX_ "can't convert empty path");
217     buf = (char *) safemalloc (len + 260 + 1001);
218
219     if (absolute_flag)
220         err = cygwin_conv_to_full_posix_path(pathname, buf);
221     else
222         err = cygwin_conv_to_posix_path(pathname, buf);
223     if (!err) {
224         ST(0) = sv_2mortal(newSVpv(buf, 0));
225         safefree(buf);
226        XSRETURN(1);
227     } else {
228         safefree(buf);
229         XSRETURN_UNDEF;
230     }
231 }
232
233 XS(XS_Cygwin_posix_to_win_path)
234 {
235     dXSARGS;
236     int absolute_flag = 0;
237     STRLEN len;
238     int err;
239     char *pathname, *buf;
240
241     if (items < 1 || items > 2)
242         Perl_croak(aTHX_ "Usage: Cygwin::posix_to_win_path(pathname, [absolute])");
243
244     pathname = SvPV(ST(0), len);
245     if (items == 2)
246         absolute_flag = SvTRUE(ST(1));
247
248     if (!len)
249         Perl_croak(aTHX_ "can't convert empty path");
250     buf = (char *) safemalloc(len + 260 + 1001);
251
252     if (absolute_flag)
253         err = cygwin_conv_to_full_win32_path(pathname, buf);
254     else
255         err = cygwin_conv_to_win32_path(pathname, buf);
256     if (!err) {
257         ST(0) = sv_2mortal(newSVpv(buf, 0));
258         safefree(buf);
259        XSRETURN(1);
260     } else {
261         safefree(buf);
262         XSRETURN_UNDEF;
263     }
264 }
265
266 XS(XS_Cygwin_mount_table)
267 {
268     dXSARGS;
269     struct mntent *mnt;
270
271     if (items != 0)
272         Perl_croak(aTHX_ "Usage: Cygwin::mount_table");
273     /* => array of [mnt_dir mnt_fsname mnt_type mnt_opts] */
274
275     setmntent (0, 0);
276     while ((mnt = getmntent (0))) {
277         AV* av = newAV();
278         av_push(av, newSVpvn(mnt->mnt_dir, strlen(mnt->mnt_dir)));
279         av_push(av, newSVpvn(mnt->mnt_fsname, strlen(mnt->mnt_fsname)));
280         av_push(av, newSVpvn(mnt->mnt_type, strlen(mnt->mnt_type)));
281         av_push(av, newSVpvn(mnt->mnt_opts, strlen(mnt->mnt_opts)));
282         XPUSHs(sv_2mortal(newRV_noinc((SV*)av)));
283     }
284     endmntent (0);
285     PUTBACK;
286 }
287
288 XS(XS_Cygwin_mount_flags)
289 {
290     dXSARGS;
291     char *pathname;
292     char flags[260];
293
294     if (items != 1)
295         Perl_croak(aTHX_ "Usage: Cygwin::mount_flags(mnt_dir)");
296
297     pathname = SvPV_nolen(ST(0));
298     
299     /* TODO: check for cygdrive registry setting. use CW_GET_CYGDRIVE_INFO then
300      */
301     if (!strcmp(pathname, "/cygdrive")) {
302         char user[260];
303         char system[260];
304         char user_flags[260];
305         char system_flags[260];
306         cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system, user_flags,
307                          system_flags);
308         if (strlen(system) > 0)
309             strcpy (flags, system_flags);
310         if (strlen(user) > 0)
311             strcpy(flags, user_flags);
312         if (strlen(flags) > 0)
313             strcat(flags, ",");
314         strcat(flags, "cygdrive");
315         ST(0) = sv_2mortal(newSVpv(flags, 0));
316         XSRETURN(1);
317     } else {
318         struct mntent *mnt;
319         setmntent (0, 0);
320         while ((mnt = getmntent (0))) {
321             if (!strcmp(pathname, mnt->mnt_dir)) {
322                 strcpy(flags, mnt->mnt_type);
323                 if (strlen(mnt->mnt_opts) > 0) {
324                     strcat(flags, ",");
325                     strcat(flags, mnt->mnt_opts);
326                 }
327                 break;
328             }
329         }
330         endmntent (0);
331         ST(0) = sv_2mortal(newSVpv(flags, 0));
332         XSRETURN(1);
333     }
334 }
335
336 XS(XS_Cygwin_is_binmount)
337 {
338     dXSARGS;
339     char *pathname;
340
341     if (items != 1)
342         Perl_croak(aTHX_ "Usage: Cygwin::is_binmount(pathname)");
343
344     pathname = SvPV_nolen(ST(0));
345
346     ST(0) = boolSV(cygwin_internal(CW_GET_BINMODE, pathname));
347     XSRETURN(1);
348 }
349
350 XS(XS_Cygwin_is_textmount)
351 {
352     dXSARGS;
353     char *pathname;
354
355     if (items != 1)
356         Perl_croak(aTHX_ "Usage: Cygwin::is_textmount(pathname)");
357
358     pathname = SvPV_nolen(ST(0));
359
360     ST(0) = boolSV(!cygwin_internal(CW_GET_BINMODE, pathname));
361     XSRETURN(1);
362 }
363
364 void
365 init_os_extras(void)
366 {
367     dTHX;
368     char *file = __FILE__;
369     void *handle;
370
371     newXS("Cwd::cwd", Cygwin_cwd, file);
372     newXSproto("Cygwin::winpid_to_pid", XS_Cygwin_winpid_to_pid, file, "$");
373     newXSproto("Cygwin::pid_to_winpid", XS_Cygwin_pid_to_winpid, file, "$");
374     newXSproto("Cygwin::win_to_posix_path", XS_Cygwin_win_to_posix_path, file, "$;$");
375     newXSproto("Cygwin::posix_to_win_path", XS_Cygwin_posix_to_win_path, file, "$;$");
376     newXSproto("Cygwin::mount_table", XS_Cygwin_mount_table, file, "");
377     newXSproto("Cygwin::mount_flags", XS_Cygwin_mount_flags, file, "$");
378     newXSproto("Cygwin::is_binmount", XS_Cygwin_is_binmount, file, "$");
379     newXSproto("Cygwin::is_textmount", XS_Cygwin_is_textmount, file, "$");
380
381     /* Initialize Win32CORE if it has been statically linked. */
382     handle = dlopen(NULL, RTLD_LAZY);
383     if (handle) {
384         void (*pfn_init)(pTHX);
385         pfn_init = (void (*)(pTHX))dlsym(handle, "init_Win32CORE");
386         if (pfn_init)
387             pfn_init(aTHX);
388         dlclose(handle);
389     }
390 }