3 * Copyright © 2001 Novell, Inc. All Rights Reserved.
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.
12 * DESCRIPTION : Main function, Commandline handlers and shutdown for NetWare implementation of Perl.
14 * Date : January 2001.
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.
49 int gThreadGroupID = -1;
53 // Global to kill all running scripts during NLM unload.
55 bool gKillAll = FALSE;
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.
62 static struct commandParserStructure gCmdParser = {0,0,0};
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.
68 BOOL gCmdProcInit = FALSE;
71 // Array to hold the screen name for all new screens.
73 char sPerlScreenName[MAX_DN_BYTES * sizeof(char)] = {'\0'};
76 // Structure to pass data when spawning new threadgroups to run scripts.
78 typedef struct tagScriptData
85 #define CS_CMD_NOT_FOUND -1 // Console command not found
86 #define CS_CMD_FOUND 0 // Console command found
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!
95 #define PERL_COMMAND_STACK_SIZE (256*1024L) // Stack size of thread that runs a perl script from command line
97 #define MAX_COMMAND_SIZE 512
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.
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 *);
111 // local function prototypes
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);
120 void fnGetPerlScreenName(char *sPerlScreenName);
122 void fnGetPerlScreenName(char *sPerlScreenName);
123 void fnSetupNamespace(void);
124 char *getcwd(char [], int);
125 void fnRunScript(ScriptData* psdata);
126 void nw_freeenviron();
129 /*============================================================================================
133 Description : Called when the NLM is first loaded. Registers the command-line handler
134 and then terminates-stay-resident.
136 Parameters : argc (IN) - No of Input strings.
137 argv (IN) - Array of Input strings.
141 ==============================================================================================*/
143 void main(int argc, char *argv[])
145 char sysCmdLine[MAX_COMMAND_SIZE] = {'\0'};
146 char cmdLineCopy[sizeof(PERL_COMMAND_NAME)+sizeof(sysCmdLine)+2] = {'\0'};
148 ScriptData* psdata = NULL;
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.
155 gThreadHandle = kCurrentThread();
157 gThreadGroupID = GetThreadGroupID ();
160 signal (SIGTERM, fnSigTermHandler);
161 fnInitGpfGlobals(); // For importing the CLIB calls in place of the Watcom calls
162 fnInitializeThreadInfo();
165 // Ensure that we have a "temp" directory
167 if (access(NWDEFPERLTEMP, 0) != 0)
168 mkdir(NWDEFPERLTEMP);
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
181 char sNUL[MAX_DN_BYTES] = {'\0'};
183 strcpy(sNUL, NWDEFPERLROOT);
184 strcat(sNUL, "\\nwnul");
185 if (access((const char *)sNUL, 0) != 0)
187 // The file, "nul" is not found and so create the file.
190 fp = fopen((const char *)sNUL, (const char *)"w");
195 fnRegisterCommandLineHandler(); // Register the command line handler
196 SynchronizeStart(); // Restart the NLM startup process when using synchronization mode.
198 fnGetPerlScreenName(sPerlScreenName); // Get the screen name. Done only once per NLM load.
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!
204 if ((argc > 1) && getcmd(sysCmdLine))
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
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.
214 psdata = (ScriptData *) malloc(sizeof(ScriptData));
217 psdata->m_commandLine = NULL;
218 psdata->m_commandLine = (char *) malloc(MAX_DN_BYTES * sizeof(char));
219 if(psdata->m_commandLine)
221 strcpy(psdata->m_commandLine, cmdLineCopy);
222 psdata->m_fromConsole = TRUE;
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);
229 // Start a new thread in its own thread group
230 BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata);
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.
249 kSuspendThread(gThreadHandle);
251 SuspendThread(GetThreadID());
260 /*============================================================================================
262 Function : fnSigTermHandler
264 Description : Called when the NLM is unloaded; used to unregister the console command handler.
266 Parameters : sig (IN)
270 ==============================================================================================*/
272 void fnSigTermHandler(int sig)
278 kResumeThread(gThreadHandle);
281 // Unregister the command line handler.
285 UnRegisterConsoleCommand (&gCmdParser);
286 gCmdProcInit = FALSE;
289 // Free the global environ buffer
292 // Kill running scripts.
294 if (!fnTerminateThreadInfo())
296 ConsolePrintf("Terminating Perl scripts...\n");
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.
304 while (!fnTerminateThreadInfo() && k < 5)
311 // Delete the file, "nul" if present since the NLM is unloaded.
313 char sNUL[MAX_DN_BYTES] = {'\0'};
315 strcpy(sNUL, NWDEFPERLROOT);
316 strcat(sNUL, "\\nwnul");
317 if (access((const char *)sNUL, 0) == 0)
319 // The file, "nul" is found and so delete it.
320 unlink((const char *)sNUL);
327 /*============================================================================================
329 Function : fnCommandLineHandler
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.
336 Parameters : screenID (IN) - id for the screen.
337 cmdLine (IN) - Command line string.
341 ==============================================================================================*/
343 LONG fnCommandLineHandler (LONG screenID, BYTE * cmdLine)
345 ScriptData* psdata=NULL;
346 int OsThrdGrpID = -1;
347 LONG retCode = CS_CMD_FOUND;
352 // Initialisation for MPK_ON
361 if (gThreadGroupID != -1)
362 OsThrdGrpID = SetThreadGroupID (gThreadGroupID);
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')))
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.
375 psdata = (ScriptData *) malloc(sizeof(ScriptData));
378 psdata->m_commandLine = NULL;
379 psdata->m_commandLine = (char *) malloc(MAX_DN_BYTES * sizeof(char));
380 if(psdata->m_commandLine)
382 strcpy(psdata->m_commandLine, (char *)cmdLine);
383 psdata->m_fromConsole = TRUE;
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);
390 // Start a new thread in its own thread group
391 BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata);
398 retCode = CS_CMD_NOT_FOUND;
402 retCode = CS_CMD_NOT_FOUND;
405 retCode = CS_CMD_NOT_FOUND;
411 if (OsThrdGrpID != -1)
412 SetThreadGroupID (OsThrdGrpID);
421 /*============================================================================================
423 Function : fnRegisterCommandLineHandler
425 Description : Registers the console command-line parsing function with the OS.
431 ==============================================================================================*/
433 void fnRegisterCommandLineHandler(void)
435 // Allocates resource tag for Console Command
436 if ((gCmdParser.RTag =
437 AllocateResourceTag (GetNLMHandle(), (char *)"Console Command", ConsoleCommandSignature)) != 0)
439 gCmdParser.parseRoutine = fnCommandLineHandler; // Set the Console Command parsing routine.
440 RegisterConsoleCommand (&gCmdParser); // Registers the Console Command parsing function
449 /*============================================================================================
451 Function : fnSetupNamespace
453 Description : Sets the name space of the current threadgroup to the long name space.
459 ==============================================================================================*/
461 void fnSetupNamespace(void)
463 SetCurrentNameSpace(NWOS2_NAME_SPACE);
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);
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
474 //Commented again, since Perl debugger had some problems because of
475 //the above call - sgp - 20th June 2000
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))
485 PFUSEACCURATECASEFORPATHS pf_useaccuratecaseforpaths = NULL;
486 pf_useaccuratecaseforpaths = (PFUSEACCURATECASEFORPATHS)
487 ImportSymbol(GetNLMHandle(), (char *)"UseAccurateCaseForPaths");
488 if (pf_useaccuratecaseforpaths)
489 (*pf_useaccuratecaseforpaths)(TRUE);
491 PFUNAUGMENTASTERISK pf_unaugmentasterisk = NULL;
492 pf_unaugmentasterisk = (PFUNAUGMENTASTERISK)
493 ImportSymbol(GetNLMHandle(), (char *)"UnAugmentAsterisk");
494 if (pf_unaugmentasterisk)
495 (*pf_unaugmentasterisk)(TRUE);
505 /*============================================================================================
507 Function : fnLaunchPerl
509 Description : Parse the command line into argc/argv style parameters and then run the script.
511 Parameters : context (IN) - void* that will be typecasted to ScriptDate structure.
515 ==============================================================================================*/
517 void fnLaunchPerl(void* context)
519 char* defaultDir = NULL;
520 char curdir[_MAX_PATH] = {'\0'};
521 ScriptData* psdata = (ScriptData *) context;
523 unsigned int moduleHandle = 0;
524 int currentThreadGroupID = -1;
533 if (psdata->m_fromConsole)
535 // get the default working directory name
537 defaultDir = fnNwGetEnvironmentStr("PERL_ROOT", NWDEFPERLROOT);
540 defaultDir = getcwd(curdir, sizeof(curdir)-1);
542 // set long name space
546 // make the working directory the current directory if from console
548 if (psdata->m_fromConsole)
557 // May have to check this, I am blindly calling UCSTerminate, irrespective of
558 // whether it is initialized or not
559 // Copied from the previous Perl - sgp - 31st Oct 2000
560 moduleHandle = FindNLMHandle("UCSCORE.NLM");
563 PFUCSTERMINATE ucsterminate = (PFUCSTERMINATE)ImportSymbol(moduleHandle, "therealUCSTerminate");
564 if (ucsterminate!=NULL)
569 if (psdata->m_fromConsole)
571 // change thread groups for the call to free the memory
572 // allocated before the new thread group was started
576 if (gThreadGroupID != -1)
577 currentThreadGroupID = SetThreadGroupID (gThreadGroupID);
584 if(psdata->m_commandLine)
586 free(psdata->m_commandLine);
587 psdata->m_commandLine = NULL;
598 if (currentThreadGroupID != -1)
599 SetThreadGroupID (currentThreadGroupID);
603 // kExitThread(NULL);
605 // just let the thread terminate by falling off the end of the
606 // function started by BeginThreadGroup
607 // ExitThread(EXIT_THREAD, 0);
616 /*============================================================================================
618 Function : fnRunScript
620 Description : Parses and runs a perl script.
622 Parameters : psdata (IN) - ScriptData structure.
626 ==============================================================================================*/
628 void fnRunScript(ScriptData* psdata)
636 PCOMMANDLINEPARSER pclp = NULL;
638 // Set up the environment block. This will only work on
639 // on Moab; on 4.11 the environment block will be empty.
642 BOOL use_system_console = TRUE;
643 BOOL newscreen = FALSE;
644 int newscreenhandle = 0;
646 // redirect stdin or stdout and run the script
647 FILE* redirOut = NULL;
648 FILE* redirIn = NULL;
649 FILE* redirErr = NULL;
650 FILE* stderr_fp = NULL;
652 int stdin_fd=-1, stdin_fd_dup=-1;
653 int stdout_fd=-1, stdout_fd_dup=-1;
654 int stderr_fd=-1, stderr_fd_dup=-1;
658 // Main callback instance
660 if (fnRegisterWithThreadTable() == FALSE)
664 // parse the command line into argc/argv style:
665 // number of params and char array of params
667 pclp = (PCOMMANDLINEPARSER) malloc(sizeof(COMMANDLINEPARSER));
670 fnUnregisterWithThreadTable();
675 // Initialise the variables
676 pclp->m_isValid = TRUE;
677 pclp->m_redirInName = NULL;
678 pclp->m_redirOutName = NULL;
679 pclp->m_redirErrName = NULL;
680 pclp->m_redirBothName = NULL;
681 pclp->nextarg = NULL;
682 pclp->sSkippedToken = NULL;
684 pclp->new_argv = NULL;
687 pclp->m_qSemaphore = NULL;
689 pclp->m_qSemaphore = 0L;
692 pclp->m_noScreen = 0;
693 pclp->m_AutoDestroy = 0;
695 pclp->m_argv_len = 1;
699 pclp->m_argv = (char **) malloc(pclp->m_argv_len * sizeof(char *));
700 if (pclp->m_argv == NULL)
705 fnUnregisterWithThreadTable();
709 pclp->m_argv[0] = (char *) malloc(MAX_DN_BYTES * sizeof(char));
710 if (pclp->m_argv[0] == NULL)
718 fnUnregisterWithThreadTable();
723 // Parse the command line
724 fnCommandLineParser(pclp, (char *)psdata->m_commandLine, FALSE);
725 if (!pclp->m_isValid)
729 for(i=0; i<pclp->m_argv_len; i++)
731 if(pclp->m_argv[i] != NULL)
733 free(pclp->m_argv[i]);
734 pclp->m_argv[i] = NULL;
745 pclp->nextarg = NULL;
747 if(pclp->sSkippedToken != NULL)
749 free(pclp->sSkippedToken);
750 pclp->sSkippedToken = NULL;
753 if(pclp->m_redirInName)
755 free(pclp->m_redirInName);
756 pclp->m_redirInName = NULL;
758 if(pclp->m_redirOutName)
760 free(pclp->m_redirOutName);
761 pclp->m_redirOutName = NULL;
763 if(pclp->m_redirErrName)
765 free(pclp->m_redirErrName);
766 pclp->m_redirErrName = NULL;
768 if(pclp->m_redirBothName)
770 free(pclp->m_redirBothName);
771 pclp->m_redirBothName = NULL;
775 // Signal a semaphore, if indicated by "-{" option, to indicate that
776 // the script has terminated and files are closed
778 if (pclp->m_qSemaphore != 0)
781 kSemaphoreSignal(pclp->m_qSemaphore);
783 SignalLocalSemaphore(pclp->m_qSemaphore);
790 fnUnregisterWithThreadTable();
795 // Simulating a shell on NetWare can be difficult. If you don't
796 // create a new screen for the script to run in, you can output to
797 // the console but you can't get any input from the console. Therefore,
798 // every invocation of perl potentially needs its own screen unless
799 // you are running either "perl -h" or "perl -v" or you are redirecting
800 // stdin from a file.
802 // So we need to create a new screen and set that screen as the current
803 // screen when running any script launched from the console that is not
804 // "perl -h" or "perl -v" and is not redirecting stdin from a file.
806 // But it would be a little weird if we didn't create a new screen only
807 // in the case when redirecting stdin from a file; in only that case,
808 // stdout would be the console instead of a new screen.
810 // There is also the issue of standard err. In short, we might as well
811 // create a new screen no matter what is going on with redirection, just
812 // for the sake of consistency.
814 // In summary, we should a create a new screen and make that screen the
815 // current screen unless one of the following is true:
816 // * The command is "perl -h"
817 // * The command is "perl -v"
818 // * The script was launched by another perl script. In this case,
819 // the screen belonging to the parent perl script should probably be
820 // the same screen for this process. And it will be if use BeginThread
821 // instead of BeginThreadGroup when launching Perl from within a Perl
824 // In those cases where we create a new screen we should probably also display
828 use_system_console = pclp->m_noScreen ||
829 ((pclp->m_argc == 2) && (strcmp(pclp->m_argv[1], (char *)"-h") == 0)) ||
830 ((pclp->m_argc == 2) && (strcmp(pclp->m_argv[1], (char *)"-v") == 0));
832 newscreen = (!use_system_console) && psdata->m_fromConsole;
836 newscreenhandle = CreateScreen(sPerlScreenName, 0);
838 DisplayScreen(newscreenhandle);
840 else if (use_system_console)
841 CreateScreen((char *)"System Console", 0);
844 if (pclp->m_redirInName)
846 if ((stdin_fd = fileno(stdin)) != -1)
848 stdin_fd_dup = dup(stdin_fd);
849 if (stdin_fd_dup != -1)
851 redirIn = fdopen (stdin_fd_dup, (char const *)"r");
853 stdin = freopen (pclp->m_redirInName, (char const *)"r", redirIn);
857 // undo the redirect, if possible
858 stdin = fdopen(stdin_fd, (char const *)"r");
865 The below code stores the handle for the existing stdout to be used later and the existing stdout is closed.
866 stdout is then initialised to the new File pointer where the operations are done onto that.
867 Later (look below for the code), the saved stdout is restored back.
869 if (pclp->m_redirOutName)
871 if ((stdout_fd = fileno(stdout)) != -1) // Handle of the existing stdout.
873 stdout_fd_dup = dup(stdout_fd);
874 if (stdout_fd_dup != -1)
876 // Close the existing stdout.
877 fflush(stdout); // Write any unwritten data to the file.
880 redirOut = fdopen (stdout_fd_dup, (char const *)"w");
882 stdout = freopen (pclp->m_redirOutName, (char const *)"w", redirOut);
886 // Undo the redirection.
887 stdout = fdopen(stdout_fd, (char const *)"w");
889 setbuf(stdout, NULL); // Unbuffered file pointer.
894 if (pclp->m_redirErrName)
896 if ((stderr_fd = fileno(stderr)) != -1)
898 stderr_fd_dup = dup(stderr_fd);
899 if (stderr_fd_dup != -1)
903 redirErr = fdopen (stderr_fd_dup, (char const *)"w");
905 stderr = freopen (pclp->m_redirErrName, (char const *)"w", redirErr);
909 // undo the redirect, if possible
910 stderr = fdopen(stderr_fd, (char const *)"w");
912 setbuf(stderr, NULL); // Unbuffered file pointer.
917 if (pclp->m_redirBothName)
919 if ((stdout_fd = fileno(stdout)) != -1)
921 stdout_fd_dup = dup(stdout_fd);
922 if (stdout_fd_dup != -1)
926 redirOut = fdopen (stdout_fd_dup, (char const *)"w");
928 stdout = freopen (pclp->m_redirBothName, (char const *)"w", redirOut);
932 // undo the redirect, if possible
933 stdout = fdopen(stdout_fd, (char const *)"w");
935 setbuf(stdout, NULL); // Unbuffered file pointer.
938 if ((stderr_fd = fileno(stderr)) != -1)
947 fnSetUpEnvBlock(&env); // Set up the ENV block
949 // Run the Perl script
950 exitstatus = RunPerl(pclp->m_argc, pclp->m_argv, env);
953 // clean up any redirection
955 if (pclp->m_redirInName && redirIn)
958 stdin = fdopen(stdin_fd, (char const *)"r"); // Put back the old handle for stdin.
961 if (pclp->m_redirOutName && redirOut)
963 // Close the new stdout.
967 // Put back the old handle for stdout.
968 stdout = fdopen(stdout_fd, (char const *)"w");
969 setbuf(stdout, NULL); // Unbuffered file pointer.
972 if (pclp->m_redirErrName && redirErr)
977 stderr = fdopen(stderr_fd, (char const *)"w"); // Put back the old handle for stderr.
978 setbuf(stderr, NULL); // Unbuffered file pointer.
981 if (pclp->m_redirBothName && redirOut)
988 stdout = fdopen(stdout_fd, (char const *)"w"); // Put back the old handle for stdout.
989 setbuf(stdout, NULL); // Unbuffered file pointer.
993 if (newscreen && newscreenhandle)
995 //added for --autodestroy switch
996 if(!pclp->m_AutoDestroy)
998 if ((redirOut == NULL) && (redirIn == NULL) && (!gKillAll))
1000 printf((char *)"\n\nPress any key to exit\n");
1004 DestroyScreen(newscreenhandle);
1007 // Set the mode for stdin and stdout
1008 fnFpSetMode(stdin, O_TEXT, dummy);
1009 fnFpSetMode(stdout, O_TEXT, dummy);
1014 for(i=0; i<pclp->m_argv_len; i++)
1016 if(pclp->m_argv[i] != NULL)
1018 free(pclp->m_argv[i]);
1019 pclp->m_argv[i] = NULL;
1024 pclp->m_argv = NULL;
1029 free(pclp->nextarg);
1030 pclp->nextarg = NULL;
1032 if(pclp->sSkippedToken != NULL)
1034 free(pclp->sSkippedToken);
1035 pclp->sSkippedToken = NULL;
1038 if(pclp->m_redirInName)
1040 free(pclp->m_redirInName);
1041 pclp->m_redirInName = NULL;
1043 if(pclp->m_redirOutName)
1045 free(pclp->m_redirOutName);
1046 pclp->m_redirOutName = NULL;
1048 if(pclp->m_redirErrName)
1050 free(pclp->m_redirErrName);
1051 pclp->m_redirErrName = NULL;
1053 if(pclp->m_redirBothName)
1055 free(pclp->m_redirBothName);
1056 pclp->m_redirBothName = NULL;
1060 // Signal a semaphore, if indicated by -{ option, to indicate that
1061 // the script has terminated and files are closed
1063 if (pclp->m_qSemaphore != 0)
1066 kSemaphoreSignal(pclp->m_qSemaphore);
1068 SignalLocalSemaphore(pclp->m_qSemaphore);
1079 fnDestroyEnvBlock(env);
1080 fnUnregisterWithThreadTable();
1081 // Remove the thread context set during Perl_set_context
1082 Remove_Thread_Ctx();
1090 /*============================================================================================
1092 Function : fnSetUpEnvBlock
1094 Description : Sets up the initial environment block.
1096 Parameters : penv (IN) - ENV variable as char***.
1100 ==============================================================================================*/
1102 void fnSetUpEnvBlock(char*** penv)
1107 char var[kMaxVariableNameLen+1] = {'\0'};
1108 char val[kMaxValueLen+1] = {'\0'};
1109 char both[kMaxVariableNameLen + kMaxValueLen + 5] = {'\0'};
1110 size_t len = kMaxValueLen;
1113 while(scanenv( &sequence, var, &len, val ))
1118 // add one for null termination
1122 env = (char **) malloc (totalcnt * sizeof(char *));
1131 while( (cnt < (totalcnt-1)) && scanenv( &sequence, var, &len, val ) )
1134 strcpy( both, var );
1135 strcat( both, (char *)"=" );
1136 strcat( both, val );
1138 env[cnt] = (char *) malloc((sizeof(both)+1) * sizeof(char));
1141 strcpy(env[cnt], both);
1146 for(i=0; i<cnt; i++)
1164 for(i=cnt; i<=(totalcnt-1); i++)
1177 /*============================================================================================
1179 Function : fnDestroyEnvBlock
1181 Description : Frees resources used by the ENV block.
1183 Parameters : env (IN) - ENV variable as char**.
1187 ==============================================================================================*/
1189 void fnDestroyEnvBlock(char** env)
1191 // It is assumed that this block is entered only if env is TRUE. So, the calling function
1192 // must check for this condition before calling fnDestroyEnvBlock.
1193 // If no check is made by the calling function, then the server abends.
1195 while (env[k] != NULL)
1210 /*============================================================================================
1212 Function : fnFpSetMode
1214 Description : Sets the mode for a file.
1216 Parameters : fp (IN) - FILE pointer for the input file.
1217 mode (IN) - Mode to be set
1220 Returns : Integer which is the set value.
1222 ==============================================================================================*/
1224 int fnFpSetMode(FILE* fp, int mode, int *err)
1228 PFFSETMODE pf_fsetmode;
1231 if (mode == O_BINARY || mode == O_TEXT)
1236 // the setmode call is not implemented (correctly) on NetWare,
1237 // but the CLIB guys were kind enough to provide another
1238 // call, fsetmode, which does a similar thing. It only works
1240 pf_fsetmode = (PFFSETMODE) ImportSymbol(GetNLMHandle(), (char *)"fsetmode");
1242 ret = (*pf_fsetmode) (fp, ((mode == O_BINARY) ? "b" : "t"));
1245 // we are on 4.11 instead of Moab, so we just return an error
1271 /*============================================================================================
1273 Function : fnInternalPerlLaunchHandler
1275 Description : Gets called by perl to spawn a new instance of perl.
1277 Parameters : cndLine (IN) - Command Line string.
1281 ==============================================================================================*/
1283 void fnInternalPerlLaunchHandler(char* cmdLine)
1285 int currentThreadGroup = -1;
1287 ScriptData* psdata=NULL;
1290 // Create a safe copy of the command line and pass it to the
1291 // new thread for parsing. The new thread will be responsible
1292 // to delete it when it is finished with it.
1293 psdata = (ScriptData *) malloc(sizeof(ScriptData));
1296 psdata->m_commandLine = NULL;
1297 psdata->m_commandLine = (char *) malloc(MAX_DN_BYTES * sizeof(char));
1299 if(psdata->m_commandLine)
1301 strcpy(psdata->m_commandLine, cmdLine);
1302 psdata->m_fromConsole = FALSE;
1305 BeginThread(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata);
1307 // Start a new thread in its own thread group
1308 BeginThread(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata);
1326 /*============================================================================================
1328 Function : fnGetPerlScreenName
1330 Description : This function creates the Perl screen name.
1331 Gets called from main only once when the Perl NLM loads.
1333 Parameters : sPerlScreenName (OUT) - Resultant Perl screen name.
1337 ==============================================================================================*/
1339 void fnGetPerlScreenName(char *sPerlScreenName)
1342 // The logic for using 32 in the below array sizes is like this:
1343 // The NetWare CLIB SDK documentation says that for base 2 conversion,
1344 // this number must be minimum 8. Also, in the example of the documentation,
1345 // 20 is used as the size and testing is done for bases from 2 upto 16.
1346 // So, to simply chose a number above 20 and also keeping in mind not to reserve
1347 // unnecessary big array sizes, I have chosen 32 !
1348 // Less than that may also suffice.
1349 char sPerlRevision[32 * sizeof(char)] = {'\0'};
1350 char sPerlVersion[32 * sizeof(char)] = {'\0'};
1351 char sPerlSubVersion[32 * sizeof(char)] = {'\0'};
1353 // The defines for PERL_REVISION, PERL_VERSION, PERL_SUBVERSION are available in
1354 // patchlevel.h under root and gets included when perl.h is included.
1355 // The number 10 below indicates base 10.
1356 itoa(PERL_REVISION, sPerlRevision, 10);
1357 itoa(PERL_VERSION, sPerlVersion, 10);
1358 itoa(PERL_SUBVERSION, sPerlSubVersion, 10);
1360 // Concatenate substrings to get a string like Perl5.6.1 which is used as the screen name.
1361 sprintf(sPerlScreenName, "%s%s.%s.%s", PERL_COMMAND_NAME,
1362 sPerlRevision, sPerlVersion, sPerlSubVersion);
1369 // Global variable to hold the environ information.
1370 // First time it is accessed, it will be created and initialized and
1371 // next time onwards, the pointer will be returned.
1373 // Improvements - Dynamically read env everytime a request comes - Is this required?
1374 char** genviron = NULL;
1377 /*============================================================================================
1379 Function : nw_getenviron
1381 Description : Gets the environment information.
1387 ==============================================================================================*/
1393 return (&genviron); // This might leak memory upto 11736 bytes on some versions of NetWare.
1394 // return genviron; // Abending on some versions of NetWare.
1396 fnSetUpEnvBlock(&genviron);
1403 /*============================================================================================
1405 Function : nw_freeenviron
1407 Description : Frees the environment information.
1413 ==============================================================================================*/
1420 fnDestroyEnvBlock(genviron);