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