This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
84915f811e94a8242524eb25b4e832bbf1d6d4c3
[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     if(items != 0)
149         Perl_croak(aTHX_ "Usage: Cwd::cwd()");
150     if((cwd = getcwd(NULL, -1))) {
151         ST(0) = sv_2mortal(newSVpv(cwd, 0));
152         free(cwd);
153 #ifndef INCOMPLETE_TAINTS
154         SvTAINTED_on(ST(0));
155 #endif
156         XSRETURN(1);
157     }
158     XSRETURN_UNDEF;
159 }
160
161 XS(XS_Cygwin_pid_to_winpid)
162 {
163     dXSARGS;
164     dXSTARG;
165     pid_t pid, RETVAL;
166
167     if (items != 1)
168         Perl_croak(aTHX_ "Usage: Cygwin::pid_to_winpid(pid)");
169
170     pid = (pid_t)SvIV(ST(0));
171
172     if ((RETVAL = cygwin_internal(CW_CYGWIN_PID_TO_WINPID, pid)) > 0) {
173         XSprePUSH; PUSHi((IV)RETVAL);
174         XSRETURN(1);
175     }
176     XSRETURN_UNDEF;
177 }
178
179 XS(XS_Cygwin_winpid_to_pid)
180 {
181     dXSARGS;
182     dXSTARG;
183     pid_t pid, RETVAL;
184
185     if (items != 1)
186         Perl_croak(aTHX_ "Usage: Cygwin::winpid_to_pid(pid)");
187
188     pid = (pid_t)SvIV(ST(0));
189
190     if ((RETVAL = cygwin32_winpid_to_pid(pid)) > 0) {
191         XSprePUSH; PUSHi((IV)RETVAL);
192         XSRETURN(1);
193     }
194     XSRETURN_UNDEF;
195 }
196
197 XS(XS_Cygwin_win_to_posix_path)
198 {
199     dXSARGS;
200     int absolute_flag = 0;
201     STRLEN len;
202     int err;
203     char *pathname, *buf;
204
205     if (items < 1 || items > 2)
206         Perl_croak(aTHX_ "Usage: Cygwin::win_to_posix_path(pathname, [absolute])");
207
208     pathname = SvPV(ST(0), len);
209     if (items == 2)
210         absolute_flag = SvTRUE(ST(1));
211
212     if (!len)
213         Perl_croak(aTHX_ "can't convert empty path");
214     buf = (char *) safemalloc (len + 260 + 1001);
215
216     if (absolute_flag)
217         err = cygwin_conv_to_full_posix_path(pathname, buf);
218     else
219         err = cygwin_conv_to_posix_path(pathname, buf);
220     if (!err) {
221         ST(0) = sv_2mortal(newSVpv(buf, 0));
222         safefree(buf);
223        XSRETURN(1);
224     } else {
225         safefree(buf);
226         XSRETURN_UNDEF;
227     }
228 }
229
230 XS(XS_Cygwin_posix_to_win_path)
231 {
232     dXSARGS;
233     int absolute_flag = 0;
234     STRLEN len;
235     int err;
236     char *pathname, *buf;
237
238     if (items < 1 || items > 2)
239         Perl_croak(aTHX_ "Usage: Cygwin::posix_to_win_path(pathname, [absolute])");
240
241     pathname = SvPV(ST(0), len);
242     if (items == 2)
243         absolute_flag = SvTRUE(ST(1));
244
245     if (!len)
246         Perl_croak(aTHX_ "can't convert empty path");
247     buf = (char *) safemalloc(len + 260 + 1001);
248
249     if (absolute_flag)
250         err = cygwin_conv_to_full_win32_path(pathname, buf);
251     else
252         err = cygwin_conv_to_win32_path(pathname, buf);
253     if (!err) {
254         ST(0) = sv_2mortal(newSVpv(buf, 0));
255         safefree(buf);
256        XSRETURN(1);
257     } else {
258         safefree(buf);
259         XSRETURN_UNDEF;
260     }
261 }
262
263 XS(XS_Cygwin_mount_table)
264 {
265     dXSARGS;
266     struct mntent *mnt;
267
268     if (items != 0)
269         Perl_croak(aTHX_ "Usage: Cygwin::mount_table");
270     /* => array of [mnt_dir mnt_fsname mnt_type mnt_opts] */
271
272     setmntent (0, 0);
273     while ((mnt = getmntent (0))) {
274         AV* av = newAV();
275         av_push(av, newSVpvn(mnt->mnt_dir, strlen(mnt->mnt_dir)));
276         av_push(av, newSVpvn(mnt->mnt_fsname, strlen(mnt->mnt_fsname)));
277         av_push(av, newSVpvn(mnt->mnt_type, strlen(mnt->mnt_type)));
278         av_push(av, newSVpvn(mnt->mnt_opts, strlen(mnt->mnt_opts)));
279         XPUSHs(sv_2mortal(newRV_noinc((SV*)av)));
280     }
281     endmntent (0);
282     PUTBACK;
283 }
284
285 XS(XS_Cygwin_mount_flags)
286 {
287     dXSARGS;
288     char *pathname;
289     char flags[260];
290
291     if (items != 1)
292         Perl_croak(aTHX_ "Usage: Cygwin::mount_flags(mnt_dir)");
293
294     pathname = SvPV_nolen(ST(0));
295     
296     /* TODO: check for cygdrive registry setting. use CW_GET_CYGDRIVE_INFO then
297      */
298     if (!strcmp(pathname, "/cygdrive")) {
299         char user[260];
300         char system[260];
301         char user_flags[260];
302         char system_flags[260];
303         cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system, user_flags,
304                          system_flags);
305         if (strlen(system) > 0)
306             strcpy (flags, system_flags);
307         if (strlen(user) > 0)
308             strcpy(flags, user_flags);
309         if (strlen(flags) > 0)
310             strcat(flags, ",");
311         strcat(flags, "cygdrive");
312         ST(0) = sv_2mortal(newSVpv(flags, 0));
313         XSRETURN(1);
314     } else {
315         struct mntent *mnt;
316         setmntent (0, 0);
317         while ((mnt = getmntent (0))) {
318             if (!strcmp(pathname, mnt->mnt_dir)) {
319                 strcpy(flags, mnt->mnt_type);
320                 if (strlen(mnt->mnt_opts) > 0) {
321                     strcat(flags, ",");
322                     strcat(flags, mnt->mnt_opts);
323                 }
324                 break;
325             }
326         }
327         endmntent (0);
328         ST(0) = sv_2mortal(newSVpv(flags, 0));
329         XSRETURN(1);
330     }
331 }
332
333 XS(XS_Cygwin_is_binmount)
334 {
335     dXSARGS;
336     char *pathname;
337
338     if (items != 1)
339         Perl_croak(aTHX_ "Usage: Cygwin::is_binmount(pathname)");
340
341     pathname = SvPV_nolen(ST(0));
342
343     ST(0) = boolSV(cygwin_internal(CW_GET_BINMODE, pathname));
344     XSRETURN(1);
345 }
346
347 XS(XS_Cygwin_is_textmount)
348 {
349     dXSARGS;
350     char *pathname;
351
352     if (items != 1)
353         Perl_croak(aTHX_ "Usage: Cygwin::is_textmount(pathname)");
354
355     pathname = SvPV_nolen(ST(0));
356
357     ST(0) = boolSV(!cygwin_internal(CW_GET_BINMODE, pathname));
358     XSRETURN(1);
359 }
360
361 void
362 init_os_extras(void)
363 {
364     dTHX;
365     char *file = __FILE__;
366     void *handle;
367
368     newXS("Cwd::cwd", Cygwin_cwd, file);
369     newXSproto("Cygwin::winpid_to_pid", XS_Cygwin_winpid_to_pid, file, "$");
370     newXSproto("Cygwin::pid_to_winpid", XS_Cygwin_pid_to_winpid, file, "$");
371     newXSproto("Cygwin::win_to_posix_path", XS_Cygwin_win_to_posix_path, file, "$;$");
372     newXSproto("Cygwin::posix_to_win_path", XS_Cygwin_posix_to_win_path, file, "$;$");
373     newXSproto("Cygwin::mount_table", XS_Cygwin_mount_table, file, "");
374     newXSproto("Cygwin::mount_flags", XS_Cygwin_mount_flags, file, "$");
375     newXSproto("Cygwin::is_binmount", XS_Cygwin_is_binmount, file, "$");
376     newXSproto("Cygwin::is_textmount", XS_Cygwin_is_textmount, file, "$");
377
378     /* Initialize Win32CORE if it has been statically linked. */
379     handle = dlopen(NULL, RTLD_LAZY);
380     if (handle) {
381         void (*pfn_init)(pTHX);
382         pfn_init = (void (*)(pTHX))dlsym(handle, "init_Win32CORE");
383         if (pfn_init)
384             pfn_init(aTHX);
385         dlclose(handle);
386     }
387 }