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 } 379