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 }