Skip the RV printing test under threads until fixed.
[p5sagit/p5-mst-13.2.git] / NetWare / Nwmain.c
CommitLineData
2986a63f 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//
55bool 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//
62static 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//
68BOOL gCmdProcInit = FALSE;
69
70
71// Array to hold the screen name for all new screens.
72//
73char sPerlScreenName[MAX_DN_BYTES * sizeof(char)] = {'\0'};
74
75
76// Structure to pass data when spawning new threadgroups to run scripts.
77//
78typedef 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
104typedef void (*PFUSEACCURATECASEFORPATHS) (int);
105typedef LONG (*PFGETFILESERVERMAJORVERSIONNUMBER) (void);
106typedef void (*PFUCSTERMINATE) (); // For ucs terminate.
107typedef void (*PFUNAUGMENTASTERISK)(BOOL); // For longfile support.
108typedef int (*PFFSETMODE) (FILE *, char *);
109
110
111// local function prototypes
112//
113void fnSigTermHandler(int sig);
114void fnRegisterCommandLineHandler(void);
115void fnLaunchPerl(void* context);
116void fnSetUpEnvBlock(char*** penv);
117void fnDestroyEnvBlock(char** env);
118int fnFpSetMode(FILE* fp, int mode, int *err);
119
120void 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
139void 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();
1db1659f 163 if (access(NWDEFPERLTEMP, 0) != 0)
164 mkdir(NWDEFPERLTEMP);
2986a63f 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
1db1659f 179 strcpy(sNUL, NWDEFPERLROOT);
2986a63f 180 strcat(sNUL, "\\nul");
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
268void 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
1db1659f 311 strcpy(sNUL, NWDEFPERLROOT);
2986a63f 312 strcat(sNUL, "\\nul");
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
339LONG 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
429void 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
457void 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
513void 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 //
1db1659f 533 defaultDir = fnNwGetEnvironmentStr("PERL_ROOT", NWDEFPERLROOT);
2986a63f 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
624void 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
1098void 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
1185void 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
1220int 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
1279void 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
1335void 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?
1370char** 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
1385char ***
1386nw_getenviron()
1387{
1388 if (genviron)
225a5dca 1389 return (&genviron); // This might leak memory upto 11736 bytes on some versions of NetWare.
1390// return genviron; // Abending on some versions of NetWare.
2986a63f 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
1411void
1412nw_freeenviron()
1413{
1414 if (genviron)
1415 {
1416 fnDestroyEnvBlock(genviron);
1417 genviron=NULL;
1418 }
1419}
1420