This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
typo in perl5100delta.pod
[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|'/cygwin')");
296
297     pathname = SvPV_nolen(ST(0));
298
299     /* TODO: Check for cygdrive registry setting,
300      *       and then use CW_GET_CYGDRIVE_INFO
301      */
302     if (!strcmp(pathname, "/cygdrive")) {
303         char user[260];
304         char system[260];
305         char user_flags[260];
306         char system_flags[260];
307
308         cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system, user_flags,
309                          system_flags);
310
311         if (strlen(user) > 0) {
312             sprintf(flags, "%s,cygdrive,%s", user_flags, user);
313         } else {
314             sprintf(flags, "%s,cygdrive,%s", system_flags, system);
315         }
316
317         ST(0) = sv_2mortal(newSVpv(flags, 0));
318         XSRETURN(1);
319
320     } else {
321         struct mntent *mnt;
322         setmntent (0, 0);
323         while ((mnt = getmntent (0))) {
324             if (!strcmp(pathname, mnt->mnt_dir)) {
325                 strcpy(flags, mnt->mnt_type);
326                 if (strlen(mnt->mnt_opts) > 0) {
327                     strcat(flags, ",");
328                     strcat(flags, mnt->mnt_opts);
329                 }
330                 break;
331             }
332         }
333         endmntent (0);
334         ST(0) = sv_2mortal(newSVpv(flags, 0));
335         XSRETURN(1);
336     }
337 }
338
339 XS(XS_Cygwin_is_binmount)
340 {
341     dXSARGS;
342     char *pathname;
343
344     if (items != 1)
345         Perl_croak(aTHX_ "Usage: Cygwin::is_binmount(pathname)");
346
347     pathname = SvPV_nolen(ST(0));
348
349     ST(0) = boolSV(cygwin_internal(CW_GET_BINMODE, pathname));
350     XSRETURN(1);
351 }
352
353 void
354 init_os_extras(void)
355 {
356     dTHX;
357     char *file = __FILE__;
358     void *handle;
359
360     newXS("Cwd::cwd", Cygwin_cwd, file);
361     newXSproto("Cygwin::winpid_to_pid", XS_Cygwin_winpid_to_pid, file, "$");
362     newXSproto("Cygwin::pid_to_winpid", XS_Cygwin_pid_to_winpid, file, "$");
363     newXSproto("Cygwin::win_to_posix_path", XS_Cygwin_win_to_posix_path, file, "$;$");
364     newXSproto("Cygwin::posix_to_win_path", XS_Cygwin_posix_to_win_path, file, "$;$");
365     newXSproto("Cygwin::mount_table", XS_Cygwin_mount_table, file, "");
366     newXSproto("Cygwin::mount_flags", XS_Cygwin_mount_flags, file, "$");
367     newXSproto("Cygwin::is_binmount", XS_Cygwin_is_binmount, file, "$");
368
369     /* Initialize Win32CORE if it has been statically linked. */
370     handle = dlopen(NULL, RTLD_LAZY);
371     if (handle) {
372         void (*pfn_init)(pTHX);
373         pfn_init = (void (*)(pTHX))dlsym(handle, "init_Win32CORE");
374         if (pfn_init)
375             pfn_init(aTHX);
376         dlclose(handle);
377     }
378 }