NetWare/Nwmain.c

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