Don't reuse temp files in tests
[perl.git] / NetWare / Nwmain.c
1
2 /*
3  * Copyright � 2001 Novell, Inc. All Rights Reserved.
4  *
5  * You may distribute under the terms of either the GNU General Public
6  * License or the Artistic License, as specified in the README file.
7  *
8  */
9
10 /*
11  * FILENAME             :       NWMain.c
12  * DESCRIPTION  :       Main function, Commandline handlers and shutdown for NetWare implementation of Perl.
13  * Author               :       HYAK, SGP
14  * Date                 :       January 2001.
15  *
16  */
17
18
19
20 #ifdef NLM
21 #define N_PLAT_NLM
22 #endif
23
24 #undef BYTE
25 #define BYTE char
26
27
28 #include <nwadv.h>
29 #include <signal.h>
30 #include <nwdsdefs.h>
31
32 #include "perl.h"
33 #include "nwutil.h"
34 #include "stdio.h"
35 #include "clibstuf.h"
36
37 #ifdef MPK_ON
38         #include <mpktypes.h>
39         #include <mpkapis.h>
40 #endif  //MPK_ON
41
42
43 // Thread group ID for this NLM. Set only by main when the NLM is initially loaded,
44 // so it should be okay for this to be global.
45 //
46 #ifdef MPK_ON
47         THREAD  gThreadHandle;
48 #else
49         int gThreadGroupID = -1;
50 #endif  //MPK_ON
51
52
53 // Global to kill all running scripts during NLM unload.
54 //
55 bool gKillAll = FALSE;
56
57
58 // Global structure needed by OS to register command parser.
59 // fnRegisterCommandLineHandler gets called only when the NLM is initially loaded,
60 // so it should be okay for this structure to be a global.
61 //
62 static struct commandParserStructure gCmdParser = {0,0,0};
63
64
65 // True if the command-line parsing procedure has been registered with the OS.
66 // Altered only during initial NLM loading or unloading so it should be okay as a global.
67 //
68 BOOL gCmdProcInit = FALSE;
69
70
71 // Array to hold the screen name for all new screens.
72 //
73 char sPerlScreenName[MAX_DN_BYTES * sizeof(char)] = {'\0'};
74
75
76 // Structure to pass data when spawning new threadgroups to run scripts.
77 //
78 typedef struct tagScriptData
79 {
80         char *m_commandLine;
81         BOOL m_fromConsole;
82 }ScriptData;
83
84
85 #define  CS_CMD_NOT_FOUND       -1              // Console command not found
86 #define  CS_CMD_FOUND           0               // Console command found
87
88 /**
89   The stack size is make 256k from the earlier 64k since complex scripts (charnames.t and complex.t)
90   were failing with the lower stack size. In fact, we tested with 128k and it also failed
91   for the complexity of the script used. In case the complexity of a script is increased,
92   then this might warrant an increase in the stack size. But instead of simply giving  a very large stack,
93   a trade off was required and we stopped at 256k!
94 **/
95 #define PERL_COMMAND_STACK_SIZE (256*1024L)     // Stack size of thread that runs a perl script from command line
96
97 #define MAX_COMMAND_SIZE 512
98
99
100 #define kMaxValueLen 1024       // Size of the Environment variable value limited/truncated to 1024 characters.
101 #define kMaxVariableNameLen 256         // Size of the Environment variable name.
102
103
104 typedef void (*PFUSEACCURATECASEFORPATHS) (int);
105 typedef LONG (*PFGETFILESERVERMAJORVERSIONNUMBER) (void);
106 typedef void (*PFUCSTERMINATE) ();              // For ucs terminate.
107 typedef void (*PFUNAUGMENTASTERISK)(BOOL);              // For longfile support.
108 typedef int (*PFFSETMODE) (FILE *, char *);
109
110
111 // local function prototypes
112 //
113 void fnSigTermHandler(int sig);
114 void fnRegisterCommandLineHandler(void);
115 void fnLaunchPerl(void* context);
116 void fnSetUpEnvBlock(char*** penv);
117 void fnDestroyEnvBlock(char** env);
118 int fnFpSetMode(FILE* fp, int mode, int *err);
119
120 void fnGetPerlScreenName(char *sPerlScreenName);
121
122 void fnGetPerlScreenName(char *sPerlScreenName);
123 void fnSetupNamespace(void); 
124 char *getcwd(char [], int); 
125 void fnRunScript(ScriptData* psdata);
126 void nw_freeenviron();
127
128
129 /*============================================================================================
130
131  Function               :       main
132
133  Description    :       Called when the NLM is first loaded. Registers the command-line handler
134                                                                 and then terminates-stay-resident.
135
136  Parameters             :       argc    (IN)    -       No of  Input  strings.
137                                                                 argv    (IN)    -       Array of  Input  strings.
138
139  Returns                :       Nothing.
140
141 ==============================================================================================*/
142
143 void main(int argc, char *argv[]) 
144 {
145         char sysCmdLine[MAX_COMMAND_SIZE] = {'\0'};
146         char cmdLineCopy[sizeof(PERL_COMMAND_NAME)+sizeof(sysCmdLine)+2] = {'\0'};
147
148         ScriptData* psdata = NULL;
149
150
151         // Keep this thread alive, since we use the thread group id of this thread to allocate memory on.
152         // When we unload the NLM, clib will tear the thread down.
153         //
154         #ifdef MPK_ON
155                 gThreadHandle = kCurrentThread();
156         #else
157                 gThreadGroupID = GetThreadGroupID ();
158         #endif  //MPK_ON
159
160         signal (SIGTERM, fnSigTermHandler);
161         fnInitGpfGlobals();             // For importing the CLIB calls in place of the Watcom calls
162         fnInitializeThreadInfo();
163
164
165 //      Ensure that we have a "temp" directory
166         fnSetupNamespace();
167         if (access(NWDEFPERLTEMP, 0) != 0)
168                 mkdir(NWDEFPERLTEMP);
169
170         // Create the file NUL if not present. This is done only once per NLM load.
171         // This is required for -e.
172         // Earlier verions were creating temporary files (in perl.c file) for -e.
173         // Now, the technique of creating temporary files are removed since they were
174         // fragile or insecure or slow. It now uses the memory by setting
175         // the BIT_BUCKET to "nul" on Win32, which is equivalent to /dev/nul of Unix.
176         // Since there is no equivalent of /dev/nul on NetWare, the work-around is that
177         // we create a file called "nul" and the BIT_BUCKET is set to "nul".
178         // This makes sure that -e works on NetWare too without the creation of temporary files
179         // in -e code in perl.c
180         {
181                 char sNUL[MAX_DN_BYTES] = {'\0'};
182
183                 strcpy(sNUL, NWDEFPERLROOT);
184                 strcat(sNUL, "\\nwnul");
185                 if (access((const char *)sNUL, 0) != 0)
186                 {
187                         // The file, "nul" is not found and so create the file.
188                         FILE *fp = NULL;
189
190                         fp = fopen((const char *)sNUL, (const char *)"w");
191                         fclose(fp);
192                 }
193         }
194
195         fnRegisterCommandLineHandler();         // Register the command line handler
196         SynchronizeStart();             // Restart the NLM startup process when using synchronization mode.
197
198         fnGetPerlScreenName(sPerlScreenName);   // Get the screen name. Done only once per NLM load.
199
200
201         // If the command line has two strings, then the first has to be "Perl" and the second is assumed
202         // to be a script to be run. If only one string (i.e., Perl) is input, then there is nothing to do!
203         //
204         if ((argc > 1) && getcmd(sysCmdLine))
205         {
206                 strcpy(cmdLineCopy, PERL_COMMAND_NAME);
207                 strcat(cmdLineCopy, (char *)" ");       // Space between the Perl Command and the input script name.
208                 strcat(cmdLineCopy, sysCmdLine);        // The command line parameters built into 
209
210                 // Create a safe copy of the command line and pass it to the
211                 // new thread for parsing. The new thread will be responsible
212                 // to delete it when it is finished with it.
213                 //
214                 psdata = (ScriptData *) malloc(sizeof(ScriptData));
215                 if (psdata)
216                 {
217                         psdata->m_commandLine = NULL;
218                         psdata->m_commandLine = (char *) malloc(MAX_DN_BYTES * sizeof(char));
219                         if(psdata->m_commandLine)
220                         {
221                                 strcpy(psdata->m_commandLine, cmdLineCopy);
222                                 psdata->m_fromConsole = TRUE;
223
224                                 #ifdef MPK_ON
225 //                                      kStartThread((char *)"ConsoleHandlerThread", fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void *)psdata);
226                                         // Establish a new thread within a new thread group.
227                                         BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata);
228                                 #else
229                                         // Start a new thread in its own thread group
230                                         BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata);
231                                 #endif  //MPK_ON
232                         }
233                         else
234                         {
235                                 free(psdata);
236                                 psdata = NULL;
237                                 return;
238                         }
239                 }
240                 else
241                         return;
242         }
243
244
245         // Keep this thread alive, since we use the thread group id of this thread to allocate memory on.
246         // When we unload the NLM, clib will tear the thread down.
247         //
248         #ifdef MPK_ON
249                 kSuspendThread(gThreadHandle);
250         #else
251                 SuspendThread(GetThreadID());
252         #endif  //MPK_ON
253
254
255         return;
256 }
257
258
259
260 /*============================================================================================
261
262  Function               :       fnSigTermHandler
263
264  Description    :       Called when the NLM is unloaded; used to unregister the console command handler.
265
266  Parameters             :       sig             (IN)
267
268  Returns                :       Nothing.
269
270 ==============================================================================================*/
271
272 void fnSigTermHandler(int sig)
273 {
274         int k = 0;
275
276
277         #ifdef MPK_ON
278                 kResumeThread(gThreadHandle);
279         #endif  //MPK_ON
280
281         // Unregister the command line handler.
282         //
283         if (gCmdProcInit)
284         {
285                 UnRegisterConsoleCommand (&gCmdParser);
286                 gCmdProcInit = FALSE;
287         }
288
289         // Free the global environ buffer
290         nw_freeenviron();
291
292         // Kill running scripts.
293         //
294         if (!fnTerminateThreadInfo())
295         {
296                 ConsolePrintf("Terminating Perl scripts...\n");
297                 gKillAll = TRUE;
298
299                 // fnTerminateThreadInfo will be run for 5 threads. If more threads/scripts are run,
300                 // then the NLM will unload without terminating the thread info and leaks more memory.
301                 // If this number is increased to reduce memory leaks, then it will unnecessarily take more time
302                 // to unload when there are a smaller no of threads. Since this is a rare case, the no is kept as 5.
303                 //
304                 while (!fnTerminateThreadInfo() && k < 5)
305                 {
306                         nw_sleep(1);
307                         k++;
308                 }
309         }
310
311         // Delete the file, "nul" if present since the NLM is unloaded.
312         {
313                 char sNUL[MAX_DN_BYTES] = {'\0'};
314
315                 strcpy(sNUL, NWDEFPERLROOT);
316                 strcat(sNUL, "\\nwnul");
317                 if (access((const char *)sNUL, 0) == 0)
318                 {
319                         // The file, "nul" is found and so delete it.
320                         unlink((const char *)sNUL);
321                 }
322         }
323 }
324
325
326
327 /*============================================================================================
328
329  Function               :       fnCommandLineHandler
330
331  Description    :       Gets called by OS when someone enters an unknown command at the system console,
332                                         after this routine is registered by RegisterConsoleCommand.
333                                         For the valid command we just spawn     a thread with enough stack space
334                                         to actually run the script.
335
336  Parameters             :       screenID        (IN)    -       id for the screen.
337                                                                 cmdLine         (IN)    -       Command line string.
338
339  Returns                :       Long.
340
341 ==============================================================================================*/
342
343 LONG  fnCommandLineHandler (LONG screenID, BYTE * cmdLine)
344 {
345         ScriptData* psdata=NULL;
346         int OsThrdGrpID = -1;
347         LONG retCode = CS_CMD_FOUND;
348         char* cptr = NULL;
349
350
351         #ifdef MPK_ON
352                 // Initialisation for MPK_ON
353         #else
354                 OsThrdGrpID = -1;
355         #endif  //MPK_ON
356
357
358         #ifdef MPK_ON
359                 // For MPK_ON
360         #else
361                 if (gThreadGroupID != -1)
362                         OsThrdGrpID = SetThreadGroupID (gThreadGroupID);
363         #endif  //MPK_ON
364
365
366         cptr = fnSkipWhite(cmdLine);    // Skip white spaces.
367         if ((strnicmp(cptr, PERL_COMMAND_NAME, strlen(PERL_COMMAND_NAME)) == 0) &&
368                  ((cptr[strlen(PERL_COMMAND_NAME)] == ' ') ||
369                  (cptr[strlen(PERL_COMMAND_NAME)] == '\t') ||
370                  (cptr[strlen(PERL_COMMAND_NAME)] == '\0')))
371         {
372                 // Create a safe copy of the command line and pass it to the new thread for parsing.
373                 // The new thread will be responsible to delete it when it is finished with it.
374                 //
375                 psdata = (ScriptData *) malloc(sizeof(ScriptData));
376                 if (psdata)
377                 {
378                         psdata->m_commandLine = NULL;
379                         psdata->m_commandLine = (char *) malloc(MAX_DN_BYTES * sizeof(char));
380                         if(psdata->m_commandLine)
381                         {
382                                 strcpy(psdata->m_commandLine, (char *)cmdLine);
383                                 psdata->m_fromConsole = TRUE;
384
385                                 #ifdef MPK_ON
386 //                                      kStartThread((char *)"ConsoleHandlerThread", fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void *)psdata);
387                                         // Establish a new thread within a new thread group.
388                                         BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata);
389                                 #else
390                                         // Start a new thread in its own thread group
391                                         BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata);
392                                 #endif  //MPK_ON
393                         }
394                         else
395                         {
396                                 free(psdata);
397                                 psdata = NULL;
398                                 retCode = CS_CMD_NOT_FOUND;
399                         }
400                 }
401                 else
402                         retCode = CS_CMD_NOT_FOUND;
403         }
404         else
405                 retCode = CS_CMD_NOT_FOUND;
406
407
408         #ifdef MPK_ON
409                 // For MPK_ON
410         #else
411                 if (OsThrdGrpID != -1)
412                         SetThreadGroupID (OsThrdGrpID);
413         #endif  //MPK_ON
414
415
416         return retCode;
417 }
418
419
420
421 /*============================================================================================
422
423  Function               :       fnRegisterCommandLineHandler
424
425  Description    :       Registers the console command-line parsing function with the OS.
426
427  Parameters             :       None.
428
429  Returns                :       Nothing.
430
431 ==============================================================================================*/
432
433 void fnRegisterCommandLineHandler(void)
434 {
435         // Allocates resource tag for Console Command
436         if ((gCmdParser.RTag =
437                 AllocateResourceTag (GetNLMHandle(), (char *)"Console Command", ConsoleCommandSignature)) != 0)
438         {
439                 gCmdParser.parseRoutine = fnCommandLineHandler;         // Set the Console Command parsing routine.
440                 RegisterConsoleCommand (&gCmdParser);           // Registers the Console Command parsing function
441                 gCmdProcInit = TRUE;
442         }
443
444         return;
445 }
446
447
448
449 /*============================================================================================
450
451  Function               :       fnSetupNamespace
452
453  Description    :       Sets the name space of the current threadgroup to the long name space.
454
455  Parameters             :       None.
456
457  Returns                :       Nothing.
458
459 ==============================================================================================*/
460
461 void fnSetupNamespace(void)
462 {
463         SetCurrentNameSpace(NWOS2_NAME_SPACE);
464
465
466         //LATER: call SetTargetNameSpace(NWOS2_NAME_SPACE)? Currently, if
467         // I make this call, then CPerlExe::Rename fails in certain cases,
468         // and it isn't clear why. Looks like a CLIB bug...
469 //      SetTargetNameSpace(NWOS2_NAME_SPACE); 
470
471         //Uncommented that above call, retaining the comment so that it will be easy 
472         //to revert back if there is any problem - sgp - 10th May 2000
473
474         //Commented again, since Perl debugger had some problems because of
475         //the above call - sgp - 20th June 2000
476
477         {
478                 // if running on Moab, call UseAccurateCaseForPaths. This API
479                 // does bad things on 4.11 so we call only for Moab.
480                 PFGETFILESERVERMAJORVERSIONNUMBER pf_getfileservermajorversionnumber = NULL;
481                 pf_getfileservermajorversionnumber = (PFGETFILESERVERMAJORVERSIONNUMBER) 
482                 ImportSymbol(GetNLMHandle(), (char *)"GetFileServerMajorVersionNumber");
483                 if (pf_getfileservermajorversionnumber && ((*pf_getfileservermajorversionnumber)() > 4))
484                 {
485                         PFUSEACCURATECASEFORPATHS pf_useaccuratecaseforpaths = NULL;
486                         pf_useaccuratecaseforpaths = (PFUSEACCURATECASEFORPATHS) 
487                         ImportSymbol(GetNLMHandle(), (char *)"UseAccurateCaseForPaths");
488                         if (pf_useaccuratecaseforpaths)
489                                 (*pf_useaccuratecaseforpaths)(TRUE);
490                         {
491                                 PFUNAUGMENTASTERISK pf_unaugmentasterisk = NULL;
492                                 pf_unaugmentasterisk = (PFUNAUGMENTASTERISK)
493                                 ImportSymbol(GetNLMHandle(), (char *)"UnAugmentAsterisk");
494                                 if (pf_unaugmentasterisk)
495                                         (*pf_unaugmentasterisk)(TRUE);
496                         }
497                 }
498         }
499
500         return;
501 }
502
503
504
505 /*============================================================================================
506
507  Function               :       fnLaunchPerl
508
509  Description    :       Parse the command line into argc/argv style parameters and then run the script.
510
511  Parameters             :       context (IN)    -       void* that will be typecasted to ScriptDate structure.
512
513  Returns                :       Nothing.
514
515 ==============================================================================================*/
516
517 void fnLaunchPerl(void* context)
518 {
519         char* defaultDir = NULL;
520         char curdir[_MAX_PATH] = {'\0'};
521         ScriptData* psdata = (ScriptData *) context;
522
523         unsigned int moduleHandle = 0;
524         int currentThreadGroupID = -1;
525
526         #ifdef MPK_ON
527                 kExitNetWare();
528         #endif  //MPK_ON
529
530         errno = 0;
531
532         if (psdata->m_fromConsole)
533         {
534                 // get the default working directory name
535                 //
536                 defaultDir = fnNwGetEnvironmentStr("PERL_ROOT", NWDEFPERLROOT);
537         }
538         else
539                 defaultDir = getcwd(curdir, sizeof(curdir)-1);
540
541         // set long name space
542         //
543         fnSetupNamespace();
544
545         // make the working directory the current directory if from console
546         //
547         if (psdata->m_fromConsole)
548                 chdir(defaultDir);
549
550         // run the script
551         //
552         fnRunScript(psdata);
553
554         // May have to check this, I am blindly calling UCSTerminate, irrespective of
555         // whether it is initialized or not
556         // Copied from the previous Perl - sgp - 31st Oct 2000
557         moduleHandle = FindNLMHandle("UCSCORE.NLM");
558         if (moduleHandle)
559         {
560                 PFUCSTERMINATE ucsterminate = (PFUCSTERMINATE)ImportSymbol(moduleHandle, "therealUCSTerminate");
561                 if (ucsterminate!=NULL)
562                         (*ucsterminate)();
563         }
564
565         if (psdata->m_fromConsole)
566         {
567                 // change thread groups for the call to free the memory
568                 // allocated before the new thread group was started
569                 #ifdef MPK_ON
570                         // For MPK_ON
571                 #else
572                         if (gThreadGroupID != -1)
573                                 currentThreadGroupID = SetThreadGroupID (gThreadGroupID);
574                 #endif  //MPK_ON
575         }
576
577         // Free memory
578         if (psdata)
579         {
580                 if(psdata->m_commandLine)
581                 {
582                         free(psdata->m_commandLine);
583                         psdata->m_commandLine = NULL;
584                 }
585
586                 free(psdata);
587                 psdata = NULL;
588                 context = NULL;
589         }
590
591         #ifdef MPK_ON
592                 // For MPK_ON
593         #else
594                 if (currentThreadGroupID != -1)
595                         SetThreadGroupID (currentThreadGroupID);
596         #endif  //MPK_ON
597
598         #ifdef MPK_ON
599 //              kExitThread(NULL);
600         #else
601                 // just let the thread terminate by falling off the end of the
602                 // function started by BeginThreadGroup
603 //              ExitThread(EXIT_THREAD, 0);
604         #endif
605
606         return;
607 }
608
609
610
611 /*============================================================================================
612
613  Function               :       fnRunScript
614
615  Description    :       Parses and runs a perl script.
616
617  Parameters             :       psdata  (IN)    -       ScriptData structure.
618
619  Returns                :       Nothing.
620
621 ==============================================================================================*/
622
623 void fnRunScript(ScriptData* psdata)
624 {
625         char **av=NULL;
626         char **en=NULL;
627         int exitstatus = 1;
628         int i=0, j=0;
629         int *dummy = 0;
630
631         PCOMMANDLINEPARSER pclp = NULL;
632
633         // Set up the environment block. This will only work on
634         // on Moab; on 4.11 the environment block will be empty.
635         char** env = NULL;
636
637         BOOL use_system_console = TRUE;
638         BOOL newscreen = FALSE;
639         int newscreenhandle = 0;
640
641         // redirect stdin or stdout and run the script
642         FILE* redirOut = NULL;
643         FILE* redirIn = NULL;
644         FILE* redirErr = NULL;
645         FILE* stderr_fp = NULL;
646
647         int stdin_fd=-1, stdin_fd_dup=-1;
648         int stdout_fd=-1, stdout_fd_dup=-1;
649         int stderr_fd=-1, stderr_fd_dup=-1;
650
651
652         // Main callback instance
653         //
654         if (fnRegisterWithThreadTable() == FALSE)
655                 return;
656
657         // parse the command line into argc/argv style:
658         // number of params and char array of params
659         //
660         pclp = (PCOMMANDLINEPARSER) malloc(sizeof(COMMANDLINEPARSER));
661         if (!pclp)
662         {
663                 fnUnregisterWithThreadTable();
664                 return;
665         }
666
667         // Initialise the variables
668         pclp->m_isValid = TRUE;
669         pclp->m_redirInName = NULL;
670         pclp->m_redirOutName = NULL;
671         pclp->m_redirErrName = NULL;
672         pclp->m_redirBothName = NULL;
673         pclp->nextarg = NULL;
674         pclp->sSkippedToken = NULL;
675         pclp->m_argv = NULL;
676         pclp->new_argv = NULL;
677
678         #ifdef MPK_ON
679                 pclp->m_qSemaphore = NULL;
680         #else
681                 pclp->m_qSemaphore = 0L;
682         #endif  //MPK_ON
683
684         pclp->m_noScreen = 0;
685         pclp->m_AutoDestroy = 0;
686         pclp->m_argc = 0;
687         pclp->m_argv_len = 1;
688
689         // Allocate memory
690         pclp->m_argv = (char **) malloc(pclp->m_argv_len * sizeof(char *));
691         if (pclp->m_argv == NULL)
692         {
693                 free(pclp);
694                 pclp = NULL;
695
696                 fnUnregisterWithThreadTable();
697                 return;
698         }
699
700         pclp->m_argv[0] = (char *) malloc(MAX_DN_BYTES * sizeof(char));
701         if (pclp->m_argv[0] == NULL)
702         {
703                 free(pclp->m_argv);
704                 pclp->m_argv=NULL;
705
706                 free(pclp);
707                 pclp = NULL;
708
709                 fnUnregisterWithThreadTable();
710                 return;
711         }
712
713         // Parse the command line
714         fnCommandLineParser(pclp, (char *)psdata->m_commandLine, FALSE);
715         if (!pclp->m_isValid)
716         {
717                 if(pclp->m_argv)
718                 {
719                         for(i=0; i<pclp->m_argv_len; i++)
720                         {
721                                 if(pclp->m_argv[i] != NULL)
722                                 {
723                                         free(pclp->m_argv[i]);
724                                         pclp->m_argv[i] = NULL;
725                                 }
726                         }
727
728                         free(pclp->m_argv);
729                         pclp->m_argv = NULL;
730                 }
731
732                 if(pclp->nextarg)
733                 {
734                         free(pclp->nextarg);
735                         pclp->nextarg = NULL;
736                 }
737                 if(pclp->sSkippedToken != NULL)
738                 {
739                         free(pclp->sSkippedToken);
740                         pclp->sSkippedToken = NULL;
741                 }
742
743                 if(pclp->m_redirInName)
744                 {
745                         free(pclp->m_redirInName);
746                         pclp->m_redirInName = NULL;
747                 }
748                 if(pclp->m_redirOutName)
749                 {
750                         free(pclp->m_redirOutName);
751                         pclp->m_redirOutName = NULL;
752                 }
753                 if(pclp->m_redirErrName)
754                 {
755                         free(pclp->m_redirErrName);
756                         pclp->m_redirErrName = NULL;
757                 }
758                 if(pclp->m_redirBothName)
759                 {
760                         free(pclp->m_redirBothName);
761                         pclp->m_redirBothName = NULL;
762                 }
763
764                 // Signal a semaphore, if indicated by "-{" option, to indicate that
765                 // the script has terminated and files are closed
766                 //
767                 if (pclp->m_qSemaphore != 0)
768                 {
769                         #ifdef MPK_ON
770                                 kSemaphoreSignal(pclp->m_qSemaphore);
771                         #else
772                                 SignalLocalSemaphore(pclp->m_qSemaphore);
773                         #endif  //MPK_ON
774                 }
775
776                 free(pclp);
777                 pclp = NULL;
778
779                 fnUnregisterWithThreadTable();
780                 return;
781         }
782
783         // Simulating a shell on NetWare can be difficult. If you don't
784         // create a new screen for the script to run in, you can output to
785         // the console but you can't get any input from the console. Therefore,
786         // every invocation of perl potentially needs its own screen unless
787         // you are running either "perl -h" or "perl -v" or you are redirecting
788         // stdin from a file.
789         //
790         // So we need to create a new screen and set that screen as the current
791         // screen when running any script launched from the console that is not
792         // "perl -h" or "perl -v" and is not redirecting stdin from a file.
793         //
794         // But it would be a little weird if we didn't create a new screen only
795         // in the case when redirecting stdin from a file; in only that case,
796         // stdout would be the console instead of a new screen.
797         //
798         // There is also the issue of standard err. In short, we might as well
799         // create a new screen no matter what is going on with redirection, just
800         // for the sake of consistency.
801         //
802         // In summary, we should a create a new screen and make that screen the
803         // current screen unless one of the following is true:
804         //  * The command is "perl -h"
805         //  * The command is "perl -v"
806         //  * The script was launched by another perl script. In this case,
807         //        the screen belonging to the parent perl script should probably be
808         //    the same screen for this process. And it will be if use BeginThread
809         //    instead of BeginThreadGroup when launching Perl from within a Perl
810         //    script.
811         //
812         // In those cases where we create a new screen we should probably also display
813         // that screen.
814         //
815
816         use_system_console = pclp->m_noScreen  ||
817                                 ((pclp->m_argc == 2) && (strcmp(pclp->m_argv[1], (char *)"-h") == 0))  ||
818                                 ((pclp->m_argc == 2) && (strcmp(pclp->m_argv[1], (char *)"-v") == 0));
819
820         newscreen = (!use_system_console) && psdata->m_fromConsole;
821
822         if (newscreen)
823         {
824                 newscreenhandle = CreateScreen(sPerlScreenName, 0);
825                 if (newscreenhandle)
826                         DisplayScreen(newscreenhandle);
827         }
828         else if (use_system_console)
829           CreateScreen((char *)"System Console", 0);
830
831         if (pclp->m_redirInName)
832         {
833                 if ((stdin_fd = fileno(stdin)) != -1)
834                 {
835                         stdin_fd_dup = dup(stdin_fd);
836                         if (stdin_fd_dup != -1)
837                         {
838                                 redirIn = fdopen (stdin_fd_dup, (char const *)"r");
839                                 if (redirIn)
840                                         stdin = freopen (pclp->m_redirInName, (char const *)"r", redirIn);
841                                 if (!stdin)
842                                 {
843                                         redirIn = NULL;
844                                         // undo the redirect, if possible
845                                         stdin = fdopen(stdin_fd, (char const *)"r");
846                                 }
847                         }
848                 }
849         }
850
851         /**
852         The below code stores the handle for the existing stdout to be used later and the existing stdout is closed.
853         stdout is then initialised to the new File pointer where the operations are done onto that.
854         Later (look below for the code), the saved stdout is restored back.
855         **/
856         if (pclp->m_redirOutName)
857         {
858                 if ((stdout_fd = fileno(stdout)) != -1)         // Handle of the existing stdout.
859                 {
860                         stdout_fd_dup = dup(stdout_fd);
861                         if (stdout_fd_dup != -1)
862                         {
863                                 // Close the existing stdout.
864                                 fflush(stdout);         // Write any unwritten data to the file.
865
866                                 // New stdout
867                                 redirOut = fdopen (stdout_fd_dup, (char const *)"w");
868                                 if (redirOut)
869                                         stdout = freopen (pclp->m_redirOutName, (char const *)"w", redirOut);
870                                 if (!stdout)
871                                 {
872                                         redirOut = NULL;
873                                         // Undo the redirection.
874                                         stdout = fdopen(stdout_fd, (char const *)"w");
875                                 }
876                                 setbuf(stdout, NULL);   // Unbuffered file pointer.
877                         }
878                 }
879         }
880
881         if (pclp->m_redirErrName)
882         {
883                 if ((stderr_fd = fileno(stderr)) != -1)
884                 {
885                         stderr_fd_dup = dup(stderr_fd);
886                         if (stderr_fd_dup != -1)
887                         {
888                                 fflush(stderr);
889
890                                 redirErr = fdopen (stderr_fd_dup, (char const *)"w");
891                                 if (redirErr)
892                                         stderr = freopen (pclp->m_redirErrName, (char const *)"w", redirErr);
893                                 if (!stderr)
894                                 {
895                                         redirErr = NULL;
896                                         // undo the redirect, if possible
897                                         stderr = fdopen(stderr_fd, (char const *)"w");
898                                 }
899                                 setbuf(stderr, NULL);   // Unbuffered file pointer.
900                         }
901                 }
902         }
903
904         if (pclp->m_redirBothName)
905         {
906                 if ((stdout_fd = fileno(stdout)) != -1)
907                 {
908                         stdout_fd_dup = dup(stdout_fd);
909                         if (stdout_fd_dup != -1)
910                         {
911                                 fflush(stdout);
912
913                                 redirOut = fdopen (stdout_fd_dup, (char const *)"w");
914                                 if (redirOut)
915                                         stdout = freopen (pclp->m_redirBothName, (char const *)"w", redirOut);
916                                 if (!stdout)
917                                 {
918                                         redirOut = NULL;
919                                         // undo the redirect, if possible
920                                         stdout = fdopen(stdout_fd, (char const *)"w");
921                                 }
922                                 setbuf(stdout, NULL);   // Unbuffered file pointer.
923                         }
924                 }
925                 if ((stderr_fd = fileno(stderr)) != -1)
926                 {
927                 stderr_fp = stderr;
928                         stderr = stdout;
929                 }
930         }
931
932         env = NULL;
933         fnSetUpEnvBlock(&env);  // Set up the ENV block
934
935         // Run the Perl script
936         exitstatus = RunPerl(pclp->m_argc, pclp->m_argv, env);
937
938         // clean up any redirection
939         //
940         if (pclp->m_redirInName && redirIn)
941         {
942                 fclose(stdin);
943                 stdin = fdopen(stdin_fd, (char const *)"r");            // Put back the old handle for stdin.
944         }
945
946         if (pclp->m_redirOutName && redirOut)
947         {
948                 // Close the new stdout.
949                 fflush(stdout);
950                 fclose(stdout);
951
952                 // Put back the old handle for stdout.
953                 stdout = fdopen(stdout_fd, (char const *)"w");
954                 setbuf(stdout, NULL);   // Unbuffered file pointer.
955         }
956
957         if (pclp->m_redirErrName && redirErr)
958         {
959                 fflush(stderr);
960                 fclose(stderr);
961
962                 stderr = fdopen(stderr_fd, (char const *)"w");          // Put back the old handle for stderr.
963                 setbuf(stderr, NULL);   // Unbuffered file pointer.
964         }
965
966         if (pclp->m_redirBothName && redirOut)
967         {
968                 stderr = stderr_fp;
969
970                 fflush(stdout);
971                 fclose(stdout);
972
973                 stdout = fdopen(stdout_fd, (char const *)"w");          // Put back the old handle for stdout.
974                 setbuf(stdout, NULL);   // Unbuffered file pointer.
975         }
976
977
978         if (newscreen && newscreenhandle)
979         {
980                 //added for --autodestroy switch
981                 if(!pclp->m_AutoDestroy)
982                 {
983                         if ((redirOut == NULL) && (redirIn == NULL) && (!gKillAll))
984                         {
985                                 printf((char *)"\n\nPress any key to exit\n");
986                                 getch();
987                         }
988                 }
989                 DestroyScreen(newscreenhandle);
990         }
991
992 /**
993         // Commented since a few abends were happening in fnFpSetMode
994         // Set the mode for stdin and stdout
995         fnFpSetMode(stdin, O_TEXT, dummy);
996         fnFpSetMode(stdout, O_TEXT, dummy);
997 **/
998         setmode(stdin, O_TEXT);
999         setmode(stdout, O_TEXT);
1000
1001         // Cleanup
1002         if(pclp->m_argv)
1003         {
1004                 for(i=0; i<pclp->m_argv_len; i++)
1005                 {
1006                         if(pclp->m_argv[i] != NULL)
1007                         {
1008                                 free(pclp->m_argv[i]);
1009                                 pclp->m_argv[i] = NULL;
1010                         }
1011                 }
1012
1013                 free(pclp->m_argv);
1014                 pclp->m_argv = NULL;
1015         }
1016
1017         if(pclp->nextarg)
1018         {
1019                 free(pclp->nextarg);
1020                 pclp->nextarg = NULL;
1021         }
1022         if(pclp->sSkippedToken != NULL)
1023         {
1024                 free(pclp->sSkippedToken);
1025                 pclp->sSkippedToken = NULL;
1026         }
1027
1028         if(pclp->m_redirInName)
1029         {
1030                 free(pclp->m_redirInName);
1031                 pclp->m_redirInName = NULL;
1032         }
1033         if(pclp->m_redirOutName)
1034         {
1035                 free(pclp->m_redirOutName);
1036                 pclp->m_redirOutName = NULL;
1037         }
1038         if(pclp->m_redirErrName)
1039         {
1040                 free(pclp->m_redirErrName);
1041                 pclp->m_redirErrName = NULL;
1042         }
1043         if(pclp->m_redirBothName)
1044         {
1045                 free(pclp->m_redirBothName);
1046                 pclp->m_redirBothName = NULL;
1047         }
1048
1049         // Signal a semaphore, if indicated by -{ option, to indicate that
1050         // the script has terminated and files are closed
1051         //
1052         if (pclp->m_qSemaphore != 0)
1053         {
1054                 #ifdef MPK_ON
1055                         kSemaphoreSignal(pclp->m_qSemaphore);
1056                 #else
1057                         SignalLocalSemaphore(pclp->m_qSemaphore);
1058                 #endif  //MPK_ON
1059         }
1060
1061         if(pclp)
1062         {
1063                 free(pclp);
1064                 pclp = NULL;
1065         }
1066
1067         if(env)
1068         {
1069                 fnDestroyEnvBlock(env);
1070                 env = NULL;
1071         }
1072
1073         fnUnregisterWithThreadTable();
1074         // Remove the thread context set during Perl_set_context
1075         Remove_Thread_Ctx();
1076
1077         return;
1078 }
1079
1080
1081
1082 /*============================================================================================
1083
1084  Function               :       fnSetUpEnvBlock
1085
1086  Description    :       Sets up the initial environment block.
1087
1088  Parameters             :       penv    (IN)    -       ENV variable as char***.
1089
1090  Returns                :       Nothing.
1091
1092 ==============================================================================================*/
1093
1094 void fnSetUpEnvBlock(char*** penv)
1095 {
1096         char** env = NULL;
1097
1098         int sequence = 0;
1099         char var[kMaxVariableNameLen+1] = {'\0'};
1100         char val[kMaxValueLen+1] = {'\0'};
1101         char both[kMaxVariableNameLen + kMaxValueLen + 5] = {'\0'};
1102         size_t len  = kMaxValueLen;
1103         int totalcnt = 0;
1104
1105         while(scanenv( &sequence, var, &len, val ))
1106         {
1107                 totalcnt++;
1108                 len  = kMaxValueLen;
1109         }
1110         // add one for null termination
1111         totalcnt++;
1112
1113         env = (char **) malloc (totalcnt * sizeof(char *));
1114         if (env)
1115         {
1116                 int cnt = 0;
1117                 int i = 0;
1118
1119                 sequence = 0;
1120                 len  = kMaxValueLen;
1121
1122                 while( (cnt < (totalcnt-1)) && scanenv( &sequence, var, &len, val ) )
1123                 {
1124                         val[len] = '\0';
1125                         strcpy( both, var );
1126                         strcat( both, (char *)"=" );
1127                         strcat( both, val );
1128
1129                         env[cnt] = (char *) malloc((sizeof(both)+1) * sizeof(char));
1130                         if (env[cnt])
1131                         {
1132                                 strcpy(env[cnt], both);
1133                                 cnt++;
1134                         }
1135                         else
1136                         {
1137                                 for(i=0; i<cnt; i++)
1138                                 {
1139                                         if(env[i])
1140                                         {
1141                                                 free(env[i]);
1142                                                 env[i] = NULL;
1143                                         }
1144                                 }
1145
1146                                 free(env);
1147                                 env = NULL;
1148
1149                                 return;
1150                         }
1151
1152                         len  = kMaxValueLen;
1153                 }
1154
1155                 for(i=cnt; i<=(totalcnt-1); i++)
1156                         env[i] = NULL;
1157         }
1158         else
1159                 return;
1160
1161         *penv = env;
1162
1163         return;
1164 }
1165
1166
1167
1168 /*============================================================================================
1169
1170  Function               :       fnDestroyEnvBlock
1171
1172  Description    :       Frees resources used by the ENV block.
1173
1174  Parameters             :       env     (IN)    -       ENV variable as char**.
1175
1176  Returns                :       Nothing.
1177
1178 ==============================================================================================*/
1179
1180 void fnDestroyEnvBlock(char** env)
1181 {
1182         // It is assumed that this block is entered only if env is TRUE. So, the calling function
1183         // must check for this condition before calling fnDestroyEnvBlock.
1184         // If no check is made by the calling function, then the server abends.
1185         int k = 0;
1186         while (env[k] != NULL)
1187         {
1188                 free(env[k]);
1189                 env[k] = NULL;
1190                 k++;
1191         }
1192
1193         free(env);
1194         env = NULL;
1195
1196         return;
1197 }
1198
1199
1200
1201 /*============================================================================================
1202
1203  Function               :       fnFpSetMode
1204
1205  Description    :       Sets the mode for a file.
1206
1207  Parameters             :       fp      (IN)    -       FILE pointer for the input file.
1208                                         mode    (IN)    -       Mode to be set
1209                                         e       (OUT)   -       Error.
1210
1211  Returns                :       Integer which is the set value.
1212
1213 ==============================================================================================*/
1214
1215 int fnFpSetMode(FILE* fp, int mode, int *err)
1216 {
1217         int ret = -1;
1218
1219         PFFSETMODE pf_fsetmode;
1220
1221         if (mode == O_BINARY || mode == O_TEXT)
1222         {
1223                 if (fp)
1224                 {
1225                         errno = 0;
1226                         // the setmode call is not implemented (correctly) on NetWare,
1227                         // but the CLIB guys were kind enough to provide another
1228                         // call, fsetmode, which does a similar thing. It only works
1229                         // on Moab
1230                         pf_fsetmode = (PFFSETMODE) ImportSymbol(GetNLMHandle(), (char *)"fsetmode");
1231                         if (pf_fsetmode)
1232                                 ret = (*pf_fsetmode) (fp, ((mode == O_BINARY) ? "b" : "t"));
1233                         else
1234                         {
1235                                 // we are on 4.11 instead of Moab, so we just return an error
1236                                 errno = ESERVER;
1237                                 err = &errno;
1238                         }
1239                         if (errno)
1240                                 err = &errno;
1241                 }
1242                 else
1243                 {
1244                         errno = EBADF;
1245                         err = &errno;
1246                 }
1247         }
1248         else
1249         {
1250                 errno = EINVAL;
1251                 err = &errno;
1252         }
1253
1254         return ret;
1255 }
1256
1257
1258
1259 /*============================================================================================
1260
1261  Function               :       fnInternalPerlLaunchHandler
1262
1263  Description    :       Gets called by perl to spawn a new instance of perl.
1264
1265  Parameters             :       cndLine (IN)    -       Command Line string.
1266
1267  Returns                :       Nothing.
1268
1269 ==============================================================================================*/
1270
1271 void fnInternalPerlLaunchHandler(char* cmdLine)
1272 {
1273         int currentThreadGroup = -1;
1274
1275         ScriptData* psdata=NULL;
1276
1277         // Create a safe copy of the command line and pass it to the
1278         // new thread for parsing. The new thread will be responsible
1279         // to delete it when it is finished with it.
1280         psdata = (ScriptData *) malloc(sizeof(ScriptData));
1281         if (psdata)
1282         {
1283                 psdata->m_commandLine = NULL;
1284                 psdata->m_commandLine = (char *) malloc(MAX_DN_BYTES * sizeof(char));
1285
1286                 if(psdata->m_commandLine)
1287                 {
1288                         strcpy(psdata->m_commandLine, cmdLine);
1289                         psdata->m_fromConsole = FALSE;
1290
1291                         #ifdef MPK_ON
1292                                 BeginThread(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata);
1293                         #else
1294                                 // Start a new thread in its own thread group
1295                                 BeginThread(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata);
1296                         #endif  //MPK_ON
1297                 }
1298                 else
1299                 {
1300                         free(psdata);
1301                         psdata = NULL;
1302                         return;
1303                 }
1304         }
1305         else
1306                 return;
1307
1308         return;
1309 }
1310
1311
1312
1313 /*============================================================================================
1314
1315  Function               :       fnGetPerlScreenName
1316
1317  Description    :       This function creates the Perl screen name.
1318                                         Gets called from main only once when the Perl NLM loads.
1319
1320  Parameters             :       sPerlScreenName (OUT)   -       Resultant Perl screen name.
1321
1322  Returns                :       Nothing.
1323
1324 ==============================================================================================*/
1325
1326 void fnGetPerlScreenName(char *sPerlScreenName)
1327 {
1328         // HYAK:
1329         // The logic for using 32 in the below array sizes is like this:
1330         // The NetWare CLIB SDK documentation says that for base 2 conversion,
1331         // this number must be minimum 8. Also, in the example of the documentation,
1332         // 20 is used as the size and testing is done for bases from 2 upto 16.
1333         // So, to simply chose a number above 20 and also keeping in mind not to reserve
1334         // unnecessary big array sizes, I have chosen 32 !
1335         // Less than that may also suffice.
1336         char sPerlRevision[32 * sizeof(char)] = {'\0'};
1337         char sPerlVersion[32 * sizeof(char)] = {'\0'};
1338         char sPerlSubVersion[32 * sizeof(char)] = {'\0'};
1339
1340         // The defines for PERL_REVISION, PERL_VERSION, PERL_SUBVERSION are available in
1341         // patchlevel.h  under root and gets included when  perl.h  is included.
1342         // The number 10 below indicates base 10.
1343         itoa(PERL_REVISION, sPerlRevision, 10);
1344         itoa(PERL_VERSION, sPerlVersion, 10);
1345         itoa(PERL_SUBVERSION, sPerlSubVersion, 10);
1346
1347         // Concatenate substrings to get a string like Perl5.6.1 which is used as the screen name.
1348         sprintf(sPerlScreenName, "%s%s.%s.%s", PERL_COMMAND_NAME,
1349                                                                         sPerlRevision, sPerlVersion, sPerlSubVersion);
1350
1351         return;
1352 }
1353
1354
1355
1356 // Global variable to hold the environ information.
1357 // First time it is accessed, it will be created and initialized and 
1358 // next time onwards, the pointer will be returned.
1359
1360 // Improvements - Dynamically read env everytime a request comes - Is this required?
1361 char** genviron = NULL;
1362
1363
1364 /*============================================================================================
1365
1366  Function               :       nw_getenviron
1367
1368  Description    :       Gets the environment information.
1369
1370  Parameters             :       None.
1371
1372  Returns                :       Nothing.
1373
1374 ==============================================================================================*/
1375
1376 char ***
1377 nw_getenviron()
1378 {
1379         if (genviron)
1380                 return (&genviron);     // This might leak memory upto 11736 bytes on some versions of NetWare.
1381 //              return genviron;        // Abending on some versions of NetWare.
1382         else
1383                 fnSetUpEnvBlock(&genviron);
1384
1385         return (&genviron);
1386 }
1387
1388
1389
1390 /*============================================================================================
1391
1392  Function               :       nw_freeenviron
1393
1394  Description    :       Frees the environment information.
1395
1396  Parameters             :       None.
1397
1398  Returns                :       Nothing.
1399
1400 ==============================================================================================*/
1401
1402 void
1403 nw_freeenviron()
1404 {
1405         if (genviron)
1406         {
1407                 fnDestroyEnvBlock(genviron);
1408                 genviron=NULL;
1409         }
1410 }
1411