NetWare/Nwmain.c

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