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