# Begin - Following is required to build NetWare specific extensions CGI2Perl, Perl2UCS and UCSExt
CGI2PERL = CGI2Perl\CGI2Perl
-PERL2UCS = $(EXTDIR)\Perl2UCS\Perl2UCS
-UCSExt = $(EXTDIR)\Perl2UCS\UCSExt
+PERL2UCS = Perl2UCS\Perl2UCS
+UCSExt = Perl2UCS\UCSExt
CGI2PERL_NLM = \CGI2Perl\CGI2Perl.NLM
PERL2UCS_NLM = $(AUTODIR)\Perl2UCS\Perl2UCS.NLM
$(PERL2UCS_NLM):
!if "$(NW_EXTNS)"=="yes"
- cd $(EXTDIR)\$(*B)
+ cd $(*B)
..\..\miniperl -I..\..\lib Makefile.PL "CCCDLFLAGS=-bool on -lang c++" PERL_CORE=1 INSTALLDIRS=perl
$(MAKE)
cd ..\..\netware
$(UCSExt_NLM):
!if "$(NW_EXTNS)"=="yes"
- cd $(EXTDIR)\$(*B)
+ cd $(*B)
..\..\miniperl -I..\..\lib Makefile.PL "CCCDLFLAGS=-bool on -lang c++" PERL_CORE=1 INSTALLDIRS=perl
$(MAKE)
cd ..\..\netware
cd cgi2perl
-del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map *.def *.lib *.pdb
cd ..
- cd $(EXTDIR)\Perl2UCS
+ cd Perl2UCS
-del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map *.def *.lib *.pdb
cd ..\..\netware
- cd $(EXTDIR)\UCSExt
+ cd UCSExt
-del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map *.c
cd ..\..\netware
!endif
struct interp_intern {
void * internal_host;
long perlshell_items; // For system() ; Ananth, 3 Sept 2001
+
+ char * perlshell_tokens; // For system() ; From Win32 of Perl 5.8 on 24 June 2002
+ char ** perlshell_vec; // For system() ; From Win32 of Perl 5.8 on 24 June 2002
};
/*
#define nw_internal_host (PL_sys_intern.internal_host)
#define nw_perlshell_items (PL_sys_intern.perlshell_items) // For system() ; Ananth, 3 Sept 2001
+#define nw_perlshell_tokens (PL_sys_intern.perlshell_tokens) // For system() ; From Win32 of Perl 5.8 on 24 June 2002
+#define nw_perlshell_vec (PL_sys_intern.perlshell_vec) // For system() ; From Win32 of Perl 5.8 on 24 June 2002
+
EXTERN_C void Perl_nw5_init(int *argcp, char ***argvp);
#define PTHREAD_ATFORK(prepare,parent,child) NOOP
#define P_NOWAIT 1
#endif
+#define EXECF_EXEC 1
+#define EXECF_SPAWN 2
+#define EXECF_SPAWN_NOWAIT 3
+
+static BOOL has_shell_metachars(char *ptr);
+
// The array is used to store pointer to the memory allocated to the TempPipeFile structure everytime
// a call to the function, nw_Popen. If a simple variable is used, everytime the memory is allocated before
// the previously allocated memory is freed, the pointer will get overwritten and the previous memory allocations
int iPopenCount = 0;
FILE* File1[MAX_PIPE_RECURSION] = {'\0'};
-
/**
General:
return -1;
nw_perlshell_items = 0; // No Shell
- New(1306, argv, (sp - mark) + nw_perlshell_items + 3, char*);
+// New(1306, argv, (sp - mark) + nw_perlshell_items + 3, char*); // In the old code of 5.6.1
+ New(1306, argv, (sp - mark) + nw_perlshell_items + 2, char*);
if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
++mark;
(char*)(really ? SvPV_nolen(really) : argv[0]),
(char**)argv);
-
if (flag != P_NOWAIT) {
if (status < 0) {
- dTHR;
+// dTHR; // Only in old code of 5.6.1
if (ckWARN(WARN_EXEC))
Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno));
status = 255 * 256;
// This feature needs to be implemented.
// _asm is commented out since it goes into the internal debugger.
// _asm {int 3};
- return(0);
+//// return(0);
+
+ // Below added to make system() work for NetWare
+
+ dTHX;
+ char **a;
+ char *s;
+ char **argv;
+ int status = -1;
+ BOOL needToTry = TRUE;
+ char *cmd2;
+
+ /* Save an extra exec if possible. See if there are shell
+ * metacharacters in it */
+ if (!has_shell_metachars(cmd)) {
+ New(1301,argv, strlen(cmd) / 2 + 2, char*);
+ New(1302,cmd2, strlen(cmd) + 1, char);
+ strcpy(cmd2, cmd);
+ a = argv;
+ for (s = cmd2; *s;) {
+ while (*s && isSPACE(*s))
+ s++;
+ if (*s)
+ *(a++) = s;
+ while (*s && !isSPACE(*s))
+ s++;
+ if (*s)
+ *s++ = '\0';
+ }
+ *a = Nullch;
+ if (argv[0]) {
+ switch (exectype) {
+ case EXECF_SPAWN:
+ status = nw_spawnvp(P_WAIT, argv[0], (char **)argv);
+ break;
+
+ case EXECF_SPAWN_NOWAIT:
+ status = nw_spawnvp(P_NOWAIT, argv[0], (char **)argv);
+ break;
+
+ case EXECF_EXEC:
+ status = nw_execvp(argv[0], (char **)argv);
+ break;
+ }
+ if (status != -1 || errno == 0)
+ needToTry = FALSE;
+ }
+ Safefree(argv);
+ Safefree(cmd2);
+ }
+
+ if (needToTry) {
+ char **argv = NULL;
+ int i = -1;
+
+ New(1306, argv, nw_perlshell_items + 2, char*);
+ while (++i < nw_perlshell_items)
+ argv[i] = nw_perlshell_vec[i];
+ argv[i++] = cmd;
+ argv[i] = Nullch;
+ switch (exectype) {
+ case EXECF_SPAWN:
+ status = nw_spawnvp(P_WAIT, argv[0], (char **)argv);
+ break;
+
+ case EXECF_SPAWN_NOWAIT:
+ status = nw_spawnvp(P_NOWAIT, argv[0], (char **)argv);
+ break;
+
+ case EXECF_EXEC:
+ status = nw_execvp(argv[0], (char **)argv);
+ break;
+ }
+ cmd = argv[0];
+ Safefree(argv);
+ }
+
+ if (exectype != EXECF_SPAWN_NOWAIT) {
+ if (status < 0) {
+ dTHR;
+ if (ckWARN(WARN_EXEC))
+ Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s",
+ (exectype == EXECF_EXEC ? "exec" : "spawn"),
+ cmd, strerror(errno));
+ status = 255 * 256;
+ }
+ else
+ status *= 256;
+ PL_statusvalue = status;
+ }
+ return (status);
}
int
do_spawn(char *cmd)
{
- return do_spawn2(cmd, 2);
+ return do_spawn2(cmd, EXECF_SPAWN);
+}
+
+// Added to make system() work for NetWare
+static BOOL
+has_shell_metachars(char *ptr)
+{
+ int inquote = 0;
+ char quote = '\0';
+
+ /*
+ * Scan string looking for redirection (< or >) or pipe
+ * characters (|) that are not in a quoted string.
+ * Shell variable interpolation (%VAR%) can also happen inside strings.
+ */
+ while (*ptr) {
+ switch(*ptr) {
+ case '%':
+ return TRUE;
+ case '\'':
+ case '\"':
+ if (inquote) {
+ if (quote == *ptr) {
+ inquote = 0;
+ quote = '\0';
+ }
+ }
+ else {
+ quote = *ptr;
+ inquote++;
+ }
+ break;
+ case '>':
+ case '<':
+ case '|':
+ if (!inquote)
+ return TRUE;
+ default:
+ break;
+ }
+ ++ptr;
+ }
+ return FALSE;
}
int
# It may also edit @modparts if required.
$modfname = &mod2fname(\@modparts) if defined &mod2fname;
+ # Truncate the module name to 8.3 format for NetWare
if (($^O eq 'NetWare') && (length($modfname) > 8)) {
$modfname = substr($modfname, 0, 8);
}
} else {
$dir = "$_/auto/$modpname";
}
- if ($^O ne 'NetWare') {
- next unless -d $dir; # skip over uninteresting directories
- }
- else {
- next if -f $dir; # skip over uninteresting directories
- }
-
+
+ next unless -d $dir; # skip over uninteresting directories
+
# check for common cases to avoid autoload of dl_findfile
my $try = $Is_MacOS ? "$dir:$modfname.$dl_dlext" : "$dir/$modfname.$dl_dlext";
- if ($^O ne 'NetWare') {
- last if $file = ($do_expand) ? dl_expandspec($try) : ((-f $try) && $try);
- }
- elsif (!(-d $try)) {
- last if $file = ($do_expand) ? dl_expandspec($try) : ($try);
- }
-
+ last if $file = ($do_expand) ? dl_expandspec($try) : ((-f $try) && $try);
+
# no luck here, save dir for possible later dl_findfile search
push @dirs, $dir;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff